home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 98 / Skunkware 98.iso / src / interp / perl5.005.tar.gz / perl5.005.tar / perl5.005 / regcomp.c < prev    next >
C/C++ Source or Header  |  1998-07-20  |  68KB  |  2,670 lines
  1. /*    regcomp.c
  2.  */
  3.  
  4. /*
  5.  * "A fair jaw-cracker dwarf-language must be."  --Samwise Gamgee
  6.  */
  7.  
  8. /* NOTE: this is derived from Henry Spencer's regexp code, and should not
  9.  * confused with the original package (see point 3 below).  Thanks, Henry!
  10.  */
  11.  
  12. /* Additional note: this code is very heavily munged from Henry's version
  13.  * in places.  In some spots I've traded clarity for efficiency, so don't
  14.  * blame Henry for some of the lack of readability.
  15.  */
  16.  
  17. /* The names of the functions have been changed from regcomp and
  18.  * regexec to  pregcomp and pregexec in order to avoid conflicts
  19.  * with the POSIX routines of the same names.
  20. */
  21.  
  22. #ifdef PERL_EXT_RE_BUILD
  23. /* need to replace pregcomp et al, so enable that */
  24. #  ifndef PERL_IN_XSUB_RE
  25. #    define PERL_IN_XSUB_RE
  26. #  endif
  27. /* need access to debugger hooks */
  28. #  ifndef DEBUGGING
  29. #    define DEBUGGING
  30. #  endif
  31. #endif
  32.  
  33. #ifdef PERL_IN_XSUB_RE
  34. /* We *really* need to overwrite these symbols: */
  35. #  define Perl_pregcomp my_regcomp
  36. #  define Perl_regdump my_regdump
  37. #  define Perl_regprop my_regprop
  38. /* *These* symbols are masked to allow static link. */
  39. #  define Perl_pregfree my_regfree
  40. #  define Perl_regnext my_regnext
  41. #endif 
  42.  
  43. /*SUPPRESS 112*/
  44. /*
  45.  * pregcomp and pregexec -- regsub and regerror are not used in perl
  46.  *
  47.  *    Copyright (c) 1986 by University of Toronto.
  48.  *    Written by Henry Spencer.  Not derived from licensed software.
  49.  *
  50.  *    Permission is granted to anyone to use this software for any
  51.  *    purpose on any computer system, and to redistribute it freely,
  52.  *    subject to the following restrictions:
  53.  *
  54.  *    1. The author is not responsible for the consequences of use of
  55.  *        this software, no matter how awful, even if they arise
  56.  *        from defects in it.
  57.  *
  58.  *    2. The origin of this software must not be misrepresented, either
  59.  *        by explicit claim or by omission.
  60.  *
  61.  *    3. Altered versions must be plainly marked as such, and must not
  62.  *        be misrepresented as being the original software.
  63.  *
  64.  *
  65.  ****    Alterations to Henry's code are...
  66.  ****
  67.  ****    Copyright (c) 1991-1997, Larry Wall
  68.  ****
  69.  ****    You may distribute under the terms of either the GNU General Public
  70.  ****    License or the Artistic License, as specified in the README file.
  71.  
  72.  *
  73.  * Beware that some of this code is subtly aware of the way operator
  74.  * precedence is structured in regular expressions.  Serious changes in
  75.  * regular-expression syntax might require a total rethink.
  76.  */
  77. #include "EXTERN.h"
  78. #include "perl.h"
  79.  
  80. #ifndef PERL_IN_XSUB_RE
  81. #  include "INTERN.h"
  82. #endif
  83.  
  84. #define REG_COMP_C
  85. #include "regcomp.h"
  86.  
  87. #ifdef op
  88. #undef op
  89. #endif /* op */
  90.  
  91. #ifdef MSDOS
  92. # if defined(BUGGY_MSC6)
  93.  /* MSC 6.00A breaks on op/regexp.t test 85 unless we turn this off */
  94.  # pragma optimize("a",off)
  95.  /* But MSC 6.00A is happy with 'w', for aliases only across function calls*/
  96.  # pragma optimize("w",on )
  97. # endif /* BUGGY_MSC6 */
  98. #endif /* MSDOS */
  99.  
  100. #ifndef STATIC
  101. #define    STATIC    static
  102. #endif
  103.  
  104. #define    ISMULT1(c)    ((c) == '*' || (c) == '+' || (c) == '?')
  105. #define    ISMULT2(s)    ((*s) == '*' || (*s) == '+' || (*s) == '?' || \
  106.     ((*s) == '{' && regcurly(s)))
  107. #ifdef atarist
  108. #define    PERL_META    "^$.[()|?+*\\"
  109. #else
  110. #define    META    "^$.[()|?+*\\"
  111. #endif
  112.  
  113. #ifdef SPSTART
  114. #undef SPSTART        /* dratted cpp namespace... */
  115. #endif
  116. /*
  117.  * Flags to be passed up and down.
  118.  */
  119. #define    WORST        0    /* Worst case. */
  120. #define    HASWIDTH    0x1    /* Known to match non-null strings. */
  121. #define    SIMPLE        0x2    /* Simple enough to be STAR/PLUS operand. */
  122. #define    SPSTART        0x4    /* Starts with * or +. */
  123. #define TRYAGAIN    0x8    /* Weeded out a declaration. */
  124.  
  125. /*
  126.  * Forward declarations for pregcomp()'s friends.
  127.  */
  128.  
  129. #ifndef PERL_OBJECT
  130. static regnode *reg _((I32, I32 *));
  131. static regnode *reganode _((U8, U32));
  132. static regnode *regatom _((I32 *));
  133. static regnode *regbranch _((I32 *, I32));
  134. static void regc _((U8, char *));
  135. static regnode *regclass _((void));
  136. STATIC I32 regcurly _((char *));
  137. static regnode *reg_node _((U8));
  138. static regnode *regpiece _((I32 *));
  139. static void reginsert _((U8, regnode *));
  140. static void regoptail _((regnode *, regnode *));
  141. static void regtail _((regnode *, regnode *));
  142. static char* regwhite _((char *, char *));
  143. static char* nextchar _((void));
  144. static void re_croak2 _((const char* pat1,const char* pat2,...)) __attribute__((noreturn));
  145. #endif
  146.  
  147. /* Length of a variant. */
  148.  
  149. #ifndef PERL_OBJECT
  150. typedef struct {
  151.     I32 len_min;
  152.     I32 len_delta;
  153.     I32 pos_min;
  154.     I32 pos_delta;
  155.     SV *last_found;
  156.     I32 last_end;            /* min value, <0 unless valid. */
  157.     I32 last_start_min;
  158.     I32 last_start_max;
  159.     SV **longest;            /* Either &l_fixed, or &l_float. */
  160.     SV *longest_fixed;
  161.     I32 offset_fixed;
  162.     SV *longest_float;
  163.     I32 offset_float_min;
  164.     I32 offset_float_max;
  165.     I32 flags;
  166. } scan_data_t;
  167. #endif
  168.  
  169. static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 };
  170.  
  171. #define SF_BEFORE_EOL        (SF_BEFORE_SEOL|SF_BEFORE_MEOL)
  172. #define SF_BEFORE_SEOL        0x1
  173. #define SF_BEFORE_MEOL        0x2
  174. #define SF_FIX_BEFORE_EOL    (SF_FIX_BEFORE_SEOL|SF_FIX_BEFORE_MEOL)
  175. #define SF_FL_BEFORE_EOL    (SF_FL_BEFORE_SEOL|SF_FL_BEFORE_MEOL)
  176.  
  177. #ifdef NO_UNARY_PLUS
  178. #  define SF_FIX_SHIFT_EOL    (0+2)
  179. #  define SF_FL_SHIFT_EOL        (0+4)
  180. #else
  181. #  define SF_FIX_SHIFT_EOL    (+2)
  182. #  define SF_FL_SHIFT_EOL        (+4)
  183. #endif
  184.  
  185. #define SF_FIX_BEFORE_SEOL    (SF_BEFORE_SEOL << SF_FIX_SHIFT_EOL)
  186. #define SF_FIX_BEFORE_MEOL    (SF_BEFORE_MEOL << SF_FIX_SHIFT_EOL)
  187.  
  188. #define SF_FL_BEFORE_SEOL    (SF_BEFORE_SEOL << SF_FL_SHIFT_EOL)
  189. #define SF_FL_BEFORE_MEOL    (SF_BEFORE_MEOL << SF_FL_SHIFT_EOL) /* 0x20 */
  190. #define SF_IS_INF        0x40
  191. #define SF_HAS_PAR        0x80
  192. #define SF_IN_PAR        0x100
  193. #define SF_HAS_EVAL        0x200
  194. #define SCF_DO_SUBSTR        0x400
  195.  
  196. STATIC void
  197. scan_commit(scan_data_t *data)
  198. {
  199.     STRLEN l = SvCUR(data->last_found);
  200.     STRLEN old_l = SvCUR(*data->longest);
  201.     
  202.     if ((l >= old_l) && ((l > old_l) || (data->flags & SF_BEFORE_EOL))) {
  203.     sv_setsv(*data->longest, data->last_found);
  204.     if (*data->longest == data->longest_fixed) {
  205.         data->offset_fixed = l ? data->last_start_min : data->pos_min;
  206.         if (data->flags & SF_BEFORE_EOL)
  207.         data->flags 
  208.             |= ((data->flags & SF_BEFORE_EOL) << SF_FIX_SHIFT_EOL);
  209.         else
  210.         data->flags &= ~SF_FIX_BEFORE_EOL;
  211.     } else {
  212.         data->offset_float_min = l ? data->last_start_min : data->pos_min;
  213.         data->offset_float_max = (l 
  214.                       ? data->last_start_max 
  215.                       : data->pos_min + data->pos_delta);
  216.         if (data->flags & SF_BEFORE_EOL)
  217.         data->flags 
  218.             |= ((data->flags & SF_BEFORE_EOL) << SF_FL_SHIFT_EOL);
  219.         else
  220.         data->flags &= ~SF_FL_BEFORE_EOL;
  221.     }
  222.     }
  223.     SvCUR_set(data->last_found, 0);
  224.     data->last_end = -1;
  225.     data->flags &= ~SF_BEFORE_EOL;
  226. }
  227.  
  228. /* Stops at toplevel WHILEM as well as at `last'. At end *scanp is set
  229.    to the position after last scanned or to NULL. */
  230.  
  231. STATIC I32
  232. study_chunk(regnode **scanp, I32 *deltap, regnode *last, scan_data_t *data, U32 flags)
  233.             /* scanp: Start here (read-write). */
  234.             /* deltap: Write maxlen-minlen here. */
  235.             /* last: Stop before this one. */
  236. {
  237.     dTHR;
  238.     I32 min = 0, pars = 0, code;
  239.     regnode *scan = *scanp, *next;
  240.     I32 delta = 0;
  241.     int is_inf = (flags & SCF_DO_SUBSTR) && (data->flags & SF_IS_INF);
  242.     I32 is_par = OP(scan) == OPEN ? ARG(scan) : 0;
  243.     scan_data_t data_fake;
  244.     
  245.     while (scan && OP(scan) != END && scan < last) {
  246.     /* Peephole optimizer: */
  247.  
  248.     if (regkind[(U8)OP(scan)] == EXACT) {
  249.         regnode *n = regnext(scan);
  250.         U32 stringok = 1;
  251. #ifdef DEBUGGING
  252.         regnode *stop = scan;
  253. #endif 
  254.  
  255.         next = scan + (*OPERAND(scan) + 2 - 1)/sizeof(regnode) + 2;
  256.         /* Skip NOTHING, merge EXACT*. */
  257.         while (n &&
  258.            ( regkind[(U8)OP(n)] == NOTHING || 
  259.              (stringok && (OP(n) == OP(scan))))
  260.            && NEXT_OFF(n)
  261.            && NEXT_OFF(scan) + NEXT_OFF(n) < I16_MAX) {
  262.         if (OP(n) == TAIL || n > next)
  263.             stringok = 0;
  264.         if (regkind[(U8)OP(n)] == NOTHING) {
  265.             NEXT_OFF(scan) += NEXT_OFF(n);
  266.             next = n + NODE_STEP_REGNODE;
  267. #ifdef DEBUGGING
  268.             if (stringok)
  269.             stop = n;
  270. #endif 
  271.             n = regnext(n);
  272.         } else {
  273.             int oldl = *OPERAND(scan);
  274.             regnode *nnext = regnext(n);
  275.             
  276.             if (oldl + *OPERAND(n) > U8_MAX) 
  277.             break;
  278.             NEXT_OFF(scan) += NEXT_OFF(n);
  279.             *OPERAND(scan) += *OPERAND(n);
  280.             next = n + (*OPERAND(n) + 2 - 1)/sizeof(regnode) + 2;
  281.             /* Now we can overwrite *n : */
  282.             Move(OPERAND(n) + 1, OPERAND(scan) + oldl + 1,
  283.              *OPERAND(n) + 1, char);
  284. #ifdef DEBUGGING
  285.             if (stringok)
  286.             stop = next - 1;
  287. #endif 
  288.             n = nnext;
  289.         }
  290.         }
  291. #ifdef DEBUGGING
  292.         /* Allow dumping */
  293.         n = scan + (*OPERAND(scan) + 2 - 1)/sizeof(regnode) + 2;
  294.         while (n <= stop) {
  295.         /* Purify reports a benign UMR here sometimes, because we
  296.          * don't initialize the OP() slot of a node when that node
  297.          * is occupied by just the trailing null of the string in
  298.          * an EXACT node */
  299.         if (regkind[(U8)OP(n)] != NOTHING || OP(n) == NOTHING) {
  300.             OP(n) = OPTIMIZED;
  301.             NEXT_OFF(n) = 0;
  302.         }
  303.         n++;
  304.         }
  305. #endif 
  306.  
  307.     }
  308.     if (OP(scan) != CURLYX) {
  309.         int max = (reg_off_by_arg[OP(scan)] ? I32_MAX : U16_MAX);
  310.         int off = (reg_off_by_arg[OP(scan)] ? ARG(scan) : NEXT_OFF(scan));
  311.         int noff;
  312.         regnode *n = scan;
  313.         
  314.         /* Skip NOTHING and LONGJMP. */
  315.         while ((n = regnext(n))
  316.            && ((regkind[(U8)OP(n)] == NOTHING && (noff = NEXT_OFF(n)))
  317.                || ((OP(n) == LONGJMP) && (noff = ARG(n))))
  318.            && off + noff < max)
  319.         off += noff;
  320.         if (reg_off_by_arg[OP(scan)])
  321.         ARG(scan) = off;
  322.         else 
  323.         NEXT_OFF(scan) = off;
  324.     }
  325.     if (OP(scan) == BRANCH || OP(scan) == BRANCHJ 
  326.            || OP(scan) == IFTHEN || OP(scan) == SUSPEND) {
  327.         next = regnext(scan);
  328.         code = OP(scan);
  329.         
  330.         if (OP(next) == code || code == IFTHEN || code == SUSPEND) { 
  331.         I32 max1 = 0, min1 = I32_MAX, num = 0;
  332.         
  333.         if (flags & SCF_DO_SUBSTR)
  334.             scan_commit(data);
  335.         while (OP(scan) == code) {
  336.             I32 deltanext, minnext;
  337.  
  338.             num++;
  339.             data_fake.flags = 0;
  340.             next = regnext(scan);
  341.             scan = NEXTOPER(scan);
  342.             if (code != BRANCH)
  343.             scan = NEXTOPER(scan);
  344.             /* We suppose the run is continuous, last=next...*/
  345.             minnext = study_chunk(&scan, &deltanext, next,
  346.                       &data_fake, 0);
  347.             if (min1 > minnext) 
  348.             min1 = minnext;
  349.             if (max1 < minnext + deltanext)
  350.             max1 = minnext + deltanext;
  351.             if (deltanext == I32_MAX)
  352.             is_inf = 1;
  353.             scan = next;
  354.             if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
  355.             pars++;
  356.             if (data && (data_fake.flags & SF_HAS_EVAL))
  357.             data->flags |= SF_HAS_EVAL;
  358.             if (code == SUSPEND) 
  359.             break;
  360.         }
  361.         if (code == IFTHEN && num < 2) /* Empty ELSE branch */
  362.             min1 = 0;
  363.         if (flags & SCF_DO_SUBSTR) {
  364.             data->pos_min += min1;
  365.             data->pos_delta += max1 - min1;
  366.             if (max1 != min1 || is_inf)
  367.             data->longest = &(data->longest_float);
  368.         }
  369.         min += min1;
  370.         delta += max1 - min1;
  371.         } else if (code == BRANCHJ)    /* single branch is optimized. */
  372.         scan = NEXTOPER(NEXTOPER(scan));
  373.         else            /* single branch is optimized. */
  374.         scan = NEXTOPER(scan);
  375.         continue;
  376.     } else if (OP(scan) == EXACT) {
  377.         min += *OPERAND(scan);
  378.         if (flags & SCF_DO_SUBSTR) { /* Update longest substr. */
  379.         I32 l = *OPERAND(scan);
  380.  
  381.         /* The code below prefers earlier match for fixed
  382.            offset, later match for variable offset.  */
  383.         if (data->last_end == -1) { /* Update the start info. */
  384.             data->last_start_min = data->pos_min;
  385.              data->last_start_max = is_inf
  386.              ? I32_MAX : data->pos_min + data->pos_delta; 
  387.         }
  388.         sv_catpvn(data->last_found, (char *)(OPERAND(scan)+1), l);
  389.         data->last_end = data->pos_min + l;
  390.         data->pos_min += l; /* As in the first entry. */
  391.         data->flags &= ~SF_BEFORE_EOL;
  392.         }
  393.     } else if (regkind[(U8)OP(scan)] == EXACT) {
  394.         if (flags & SCF_DO_SUBSTR) 
  395.         scan_commit(data);
  396.         min += *OPERAND(scan);
  397.         if (data && (flags & SCF_DO_SUBSTR))
  398.         data->pos_min += *OPERAND(scan);
  399.     } else if (strchr(varies,OP(scan))) {
  400.         I32 mincount, maxcount, minnext, deltanext, pos_before, fl;
  401.         regnode *oscan = scan;
  402.         
  403.         switch (regkind[(U8)OP(scan)]) {
  404.         case WHILEM:
  405.         scan = NEXTOPER(scan);
  406.         goto finish;
  407.         case PLUS:
  408.         if (flags & SCF_DO_SUBSTR) {
  409.             next = NEXTOPER(scan);
  410.             if (OP(next) == EXACT) {
  411.             mincount = 1; 
  412.             maxcount = REG_INFTY; 
  413.             next = regnext(scan);
  414.             scan = NEXTOPER(scan);
  415.             goto do_curly;
  416.             }
  417.         }
  418.         if (flags & SCF_DO_SUBSTR)
  419.             data->pos_min++;
  420.         min++;
  421.         /* Fall through. */
  422.         case STAR:
  423.         is_inf = 1; 
  424.         scan = regnext(scan);
  425.         if (flags & SCF_DO_SUBSTR) {
  426.             scan_commit(data);
  427.             data->longest = &(data->longest_float);
  428.         }
  429.         goto optimize_curly_tail;
  430.         case CURLY:
  431.         mincount = ARG1(scan); 
  432.         maxcount = ARG2(scan);
  433.         next = regnext(scan);
  434.         scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
  435.           do_curly:
  436.         if (flags & SCF_DO_SUBSTR) {
  437.             if (mincount == 0) scan_commit(data);
  438.             pos_before = data->pos_min;
  439.         }
  440.         if (data) {
  441.             fl = data->flags;
  442.             data->flags &= ~(SF_HAS_PAR|SF_IN_PAR|SF_HAS_EVAL);
  443.             if (is_inf)
  444.             data->flags |= SF_IS_INF;
  445.         }
  446.         /* This will finish on WHILEM, setting scan, or on NULL: */
  447.         minnext = study_chunk(&scan, &deltanext, last, data, 
  448.                       mincount == 0 
  449.                     ? (flags & ~SCF_DO_SUBSTR) : flags);
  450.         if (!scan)         /* It was not CURLYX, but CURLY. */
  451.             scan = next;
  452.         if (PL_dowarn && (minnext + deltanext == 0) 
  453.             && !(data->flags & (SF_HAS_PAR|SF_IN_PAR))
  454.             && maxcount <= 10000) /* Complement check for big count */
  455.             warn("Strange *+?{} on zero-length expression");
  456.         min += minnext * mincount;
  457.         is_inf |= (maxcount == REG_INFTY && (minnext + deltanext) > 0
  458.                || deltanext == I32_MAX);
  459.         delta += (minnext + deltanext) * maxcount - minnext * mincount;
  460.  
  461.         /* Try powerful optimization CURLYX => CURLYN. */
  462.         if (  OP(oscan) == CURLYX && data 
  463.               && data->flags & SF_IN_PAR
  464.               && !(data->flags & SF_HAS_EVAL)
  465.               && !deltanext && minnext == 1 ) {
  466.             /* Try to optimize to CURLYN.  */
  467.             regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS;
  468.             regnode *nxt1 = nxt, *nxt2;
  469.  
  470.             /* Skip open. */
  471.             nxt = regnext(nxt);
  472.             if (!strchr(simple,OP(nxt))
  473.             && !(regkind[(U8)OP(nxt)] == EXACT
  474.                  && *OPERAND(nxt) == 1)) 
  475.             goto nogo;
  476.             nxt2 = nxt;
  477.             nxt = regnext(nxt);
  478.             if (OP(nxt) != CLOSE) 
  479.             goto nogo;
  480.             /* Now we know that nxt2 is the only contents: */
  481.             oscan->flags = ARG(nxt);
  482.             OP(oscan) = CURLYN;
  483.             OP(nxt1) = NOTHING;    /* was OPEN. */
  484. #ifdef DEBUGGING
  485.             OP(nxt1 + 1) = OPTIMIZED; /* was count. */
  486.             NEXT_OFF(nxt1+ 1) = 0; /* just for consistancy. */
  487.             NEXT_OFF(nxt2) = 0;    /* just for consistancy with CURLY. */
  488.             OP(nxt) = OPTIMIZED;    /* was CLOSE. */
  489.             OP(nxt + 1) = OPTIMIZED; /* was count. */
  490.             NEXT_OFF(nxt+ 1) = 0; /* just for consistancy. */
  491. #endif 
  492.         }
  493.           nogo:
  494.  
  495.         /* Try optimization CURLYX => CURLYM. */
  496.         if (  OP(oscan) == CURLYX && data 
  497.               && !(data->flags & SF_HAS_PAR)
  498.               && !(data->flags & SF_HAS_EVAL)
  499.               && !deltanext  ) {
  500.             /* XXXX How to optimize if data == 0? */
  501.             /* Optimize to a simpler form.  */
  502.             regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN */
  503.             regnode *nxt2;
  504.  
  505.             OP(oscan) = CURLYM;
  506.             while ( (nxt2 = regnext(nxt)) /* skip over embedded stuff*/
  507.                 && (OP(nxt2) != WHILEM)) 
  508.             nxt = nxt2;
  509.             OP(nxt2)  = SUCCEED; /* Whas WHILEM */
  510.             /* Need to optimize away parenths. */
  511.             if (data->flags & SF_IN_PAR) {
  512.             /* Set the parenth number.  */
  513.             regnode *nxt1 = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN*/
  514.  
  515.             if (OP(nxt) != CLOSE) 
  516.                 FAIL("panic opt close");
  517.             oscan->flags = ARG(nxt);
  518.             OP(nxt1) = OPTIMIZED;    /* was OPEN. */
  519.             OP(nxt) = OPTIMIZED;    /* was CLOSE. */
  520. #ifdef DEBUGGING
  521.             OP(nxt1 + 1) = OPTIMIZED; /* was count. */
  522.             OP(nxt + 1) = OPTIMIZED; /* was count. */
  523.             NEXT_OFF(nxt1 + 1) = 0; /* just for consistancy. */
  524.             NEXT_OFF(nxt + 1) = 0; /* just for consistancy. */
  525. #endif 
  526. #if 0
  527.             while ( nxt1 && (OP(nxt1) != WHILEM)) {
  528.                 regnode *nnxt = regnext(nxt1);
  529.                 
  530.                 if (nnxt == nxt) {
  531.                 if (reg_off_by_arg[OP(nxt1)])
  532.                     ARG_SET(nxt1, nxt2 - nxt1);
  533.                 else if (nxt2 - nxt1 < U16_MAX)
  534.                     NEXT_OFF(nxt1) = nxt2 - nxt1;
  535.                 else
  536.                     OP(nxt) = NOTHING;    /* Cannot beautify */
  537.                 }
  538.                 nxt1 = nnxt;
  539.             }
  540. #endif
  541.             /* Optimize again: */
  542.             study_chunk(&nxt1, &deltanext, nxt, NULL, 0);
  543.             } else
  544.             oscan->flags = 0;
  545.         }
  546.         if (data && fl & (SF_HAS_PAR|SF_IN_PAR)) 
  547.             pars++;
  548.         if (flags & SCF_DO_SUBSTR) {
  549.             SV *last_str = Nullsv;
  550.             int counted = mincount != 0;
  551.  
  552.             if (data->last_end > 0 && mincount != 0) { /* Ends with a string. */
  553.             I32 b = pos_before >= data->last_start_min 
  554.                 ? pos_before : data->last_start_min;
  555.             STRLEN l;
  556.             char *s = SvPV(data->last_found, l);
  557.             
  558.             l -= b - data->last_start_min;
  559.             /* Get the added string: */
  560.             last_str = newSVpv(s  +  b - data->last_start_min, l);
  561.             if (deltanext == 0 && pos_before == b) {
  562.                 /* What was added is a constant string */
  563.                 if (mincount > 1) {
  564.                 SvGROW(last_str, (mincount * l) + 1);
  565.                 repeatcpy(SvPVX(last_str) + l, 
  566.                       SvPVX(last_str), l, mincount - 1);
  567.                 SvCUR(last_str) *= mincount;
  568.                 /* Add additional parts. */
  569.                 SvCUR_set(data->last_found, 
  570.                       SvCUR(data->last_found) - l);
  571.                 sv_catsv(data->last_found, last_str);
  572.                 data->last_end += l * (mincount - 1);
  573.                 }
  574.             }
  575.             }
  576.             /* It is counted once already... */
  577.             data->pos_min += minnext * (mincount - counted);
  578.             data->pos_delta += - counted * deltanext +
  579.             (minnext + deltanext) * maxcount - minnext * mincount;
  580.             if (mincount != maxcount) {
  581.             scan_commit(data);
  582.             if (mincount && last_str) {
  583.                 sv_setsv(data->last_found, last_str);
  584.                 data->last_end = data->pos_min;
  585.                 data->last_start_min = 
  586.                 data->pos_min - SvCUR(last_str);
  587.                 data->last_start_max = is_inf 
  588.                 ? I32_MAX 
  589.                 : data->pos_min + data->pos_delta
  590.                 - SvCUR(last_str);
  591.             }
  592.             data->longest = &(data->longest_float);
  593.             }
  594.         }
  595.         if (data && (fl & SF_HAS_EVAL))
  596.             data->flags |= SF_HAS_EVAL;
  597.           optimize_curly_tail:
  598.         if (OP(oscan) != CURLYX) {
  599.             while (regkind[(U8)OP(next = regnext(oscan))] == NOTHING
  600.                && NEXT_OFF(next))
  601.             NEXT_OFF(oscan) += NEXT_OFF(next);
  602.         }
  603.         continue;
  604.         default:            /* REF only? */
  605.         if (flags & SCF_DO_SUBSTR) {
  606.             scan_commit(data);
  607.             data->longest = &(data->longest_float);
  608.         }
  609.         is_inf = 1;
  610.         break;
  611.         }
  612.     } else if (strchr(simple,OP(scan))) {
  613.         if (flags & SCF_DO_SUBSTR) {
  614.         scan_commit(data);
  615.         data->pos_min++;
  616.         }
  617.         min++;
  618.     } else if (regkind[(U8)OP(scan)] == EOL && flags & SCF_DO_SUBSTR) {
  619.         data->flags |= (OP(scan) == MEOL
  620.                 ? SF_BEFORE_MEOL
  621.                 : SF_BEFORE_SEOL);
  622.     } else if (regkind[(U8)OP(scan)] == BRANCHJ
  623.            && (scan->flags || data)
  624.            && (OP(scan) == IFMATCH || OP(scan) == UNLESSM)) {
  625.         I32 deltanext, minnext;
  626.         regnode *nscan;
  627.  
  628.         data_fake.flags = 0;
  629.         next = regnext(scan);
  630.         nscan = NEXTOPER(NEXTOPER(scan));
  631.         minnext = study_chunk(&nscan, &deltanext, last, &data_fake, 0);
  632.         if (scan->flags) {
  633.         if (deltanext) {
  634.             FAIL("variable length lookbehind not implemented");
  635.         } else if (minnext > U8_MAX) {
  636.             FAIL2("lookbehind longer than %d not implemented", U8_MAX);
  637.         }
  638.         scan->flags = minnext;
  639.         }
  640.         if (data && data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
  641.         pars++;
  642.         if (data && (data_fake.flags & SF_HAS_EVAL))
  643.         data->flags |= SF_HAS_EVAL;
  644.     } else if (OP(scan) == OPEN) {
  645.         pars++;
  646.     } else if (OP(scan) == CLOSE && ARG(scan) == is_par) {
  647.         next = regnext(scan);
  648.  
  649.         if ( next && (OP(next) != WHILEM) && next < last)
  650.         is_par = 0;        /* Disable optimization */
  651.     } else if (OP(scan) == EVAL) {
  652.         if (data)
  653.             data->flags |= SF_HAS_EVAL;
  654.     }
  655.     /* Else: zero-length, ignore. */
  656.     scan = regnext(scan);
  657.     }
  658.  
  659.   finish:
  660.     *scanp = scan;
  661.     *deltap = is_inf ? I32_MAX : delta;
  662.     if (flags & SCF_DO_SUBSTR && is_inf) 
  663.     data->pos_delta = I32_MAX - data->pos_min;
  664.     if (is_par > U8_MAX)
  665.     is_par = 0;
  666.     if (is_par && pars==1 && data) {
  667.     data->flags |= SF_IN_PAR;
  668.     data->flags &= ~SF_HAS_PAR;
  669.     } else if (pars && data) {
  670.     data->flags |= SF_HAS_PAR;
  671.     data->flags &= ~SF_IN_PAR;
  672.     }
  673.     return min;
  674. }
  675.  
  676. STATIC I32
  677. add_data(I32 n, char *s)
  678. {
  679.     dTHR;
  680.     if (PL_regcomp_rx->data) {
  681.     Renewc(PL_regcomp_rx->data, 
  682.            sizeof(*PL_regcomp_rx->data) + sizeof(void*) * (PL_regcomp_rx->data->count + n - 1), 
  683.            char, struct reg_data);
  684.     Renew(PL_regcomp_rx->data->what, PL_regcomp_rx->data->count + n, U8);
  685.     PL_regcomp_rx->data->count += n;
  686.     } else {
  687.     Newc(1207, PL_regcomp_rx->data, sizeof(*PL_regcomp_rx->data) + sizeof(void*) * (n - 1),
  688.          char, struct reg_data);
  689.     New(1208, PL_regcomp_rx->data->what, n, U8);
  690.     PL_regcomp_rx->data->count = n;
  691.     }
  692.     Copy(s, PL_regcomp_rx->data->what + PL_regcomp_rx->data->count - n, n, U8);
  693.     return PL_regcomp_rx->data->count - n;
  694. }
  695.  
  696. /*
  697.  - pregcomp - compile a regular expression into internal code
  698.  *
  699.  * We can't allocate space until we know how big the compiled form will be,
  700.  * but we can't compile it (and thus know how big it is) until we've got a
  701.  * place to put the code.  So we cheat:  we compile it twice, once with code
  702.  * generation turned off and size counting turned on, and once "for real".
  703.  * This also means that we don't allocate space until we are sure that the
  704.  * thing really will compile successfully, and we never have to move the
  705.  * code and thus invalidate pointers into it.  (Note that it has to be in
  706.  * one piece because free() must be able to free it all.) [NB: not true in perl]
  707.  *
  708.  * Beware that the optimization-preparation code in here knows about some
  709.  * of the structure of the compiled regexp.  [I'll say.]
  710.  */
  711. regexp *
  712. pregcomp(char *exp, char *xend, PMOP *pm)
  713. {
  714.     dTHR;
  715.     register regexp *r;
  716.     regnode *scan;
  717.     SV **longest;
  718.     SV *longest_fixed;
  719.     SV *longest_float;
  720.     regnode *first;
  721.     I32 flags;
  722.     I32 minlen = 0;
  723.     I32 sawplus = 0;
  724.     I32 sawopen = 0;
  725.  
  726.     if (exp == NULL)
  727.     FAIL("NULL regexp argument");
  728.  
  729.     PL_regprecomp = savepvn(exp, xend - exp);
  730.     DEBUG_r(PerlIO_printf(Perl_debug_log, "compiling RE `%*s'\n",
  731.               xend - exp, PL_regprecomp));
  732.     PL_regflags = pm->op_pmflags;
  733.     PL_regsawback = 0;
  734.  
  735.     PL_regseen = 0;
  736.     PL_seen_zerolen = *exp == '^' ? -1 : 0;
  737.     PL_seen_evals = 0;
  738.     PL_extralen = 0;
  739.  
  740.     /* First pass: determine size, legality. */
  741.     PL_regcomp_parse = exp;
  742.     PL_regxend = xend;
  743.     PL_regnaughty = 0;
  744.     PL_regnpar = 1;
  745.     PL_regsize = 0L;
  746.     PL_regcode = &PL_regdummy;
  747.     regc((U8)MAGIC, (char*)PL_regcode);
  748.     if (reg(0, &flags) == NULL) {
  749.     Safefree(PL_regprecomp);
  750.     PL_regprecomp = Nullch;
  751.     return(NULL);
  752.     }
  753.     DEBUG_r(PerlIO_printf(Perl_debug_log, "size %d ", PL_regsize));
  754.  
  755.     DEBUG_r(
  756.     if (!PL_colorset) {
  757.         int i = 0;
  758.         char *s = PerlEnv_getenv("TERMCAP_COLORS");
  759.         
  760.         PL_colorset = 1;
  761.         if (s) {
  762.         PL_colors[0] = s = savepv(s);
  763.         while (++i < 4) {
  764.             s = strchr(s, '\t');
  765.             if (!s) 
  766.             FAIL("Not enough TABs in TERMCAP_COLORS");
  767.             *s = '\0';
  768.             PL_colors[i] = ++s;
  769.         }
  770.         } else {
  771.         while (i < 4) 
  772.             PL_colors[i++] = "";
  773.         }
  774.         /* Reset colors: */
  775.         PerlIO_printf(Perl_debug_log, "%s%s%s%s", 
  776.               PL_colors[0],PL_colors[1],PL_colors[2],PL_colors[3]);
  777.     }
  778.     );
  779.  
  780.     /* Small enough for pointer-storage convention?
  781.        If extralen==0, this means that we will not need long jumps. */
  782.     if (PL_regsize >= 0x10000L && PL_extralen)
  783.         PL_regsize += PL_extralen;
  784.     else
  785.     PL_extralen = 0;
  786.  
  787.     /* Allocate space and initialize. */
  788.     Newc(1001, r, sizeof(regexp) + (unsigned)PL_regsize * sizeof(regnode),
  789.      char, regexp);
  790.     if (r == NULL)
  791.     FAIL("regexp out of space");
  792.     r->refcnt = 1;
  793.     r->prelen = xend - exp;
  794.     r->precomp = PL_regprecomp;
  795.     r->subbeg = r->subbase = NULL;
  796.     r->nparens = PL_regnpar - 1;        /* set early to validate backrefs */
  797.     PL_regcomp_rx = r;
  798.  
  799.     /* Second pass: emit code. */
  800.     PL_regcomp_parse = exp;
  801.     PL_regxend = xend;
  802.     PL_regnaughty = 0;
  803.     PL_regnpar = 1;
  804.     PL_regcode = r->program;
  805.     /* Store the count of eval-groups for security checks: */
  806.     PL_regcode->next_off = ((PL_seen_evals > U16_MAX) ? U16_MAX : PL_seen_evals);
  807.     regc((U8)MAGIC, (char*) PL_regcode++);
  808.     r->data = 0;
  809.     if (reg(0, &flags) == NULL)
  810.     return(NULL);
  811.  
  812.     /* Dig out information for optimizations. */
  813.     r->reganch = pm->op_pmflags & PMf_COMPILETIME;
  814.     pm->op_pmflags = PL_regflags;
  815.     r->regstclass = NULL;
  816.     r->naughty = PL_regnaughty >= 10;    /* Probably an expensive pattern. */
  817.     scan = r->program + 1;        /* First BRANCH. */
  818.  
  819.     /* XXXX To minimize changes to RE engine we always allocate
  820.        3-units-long substrs field. */
  821.     Newz(1004, r->substrs, 1, struct reg_substr_data);
  822.  
  823.     if (OP(scan) != BRANCH) {    /* Only one top-level choice. */
  824.     scan_data_t data;
  825.     I32 fake;
  826.     STRLEN longest_float_length, longest_fixed_length;
  827.  
  828.     StructCopy(&zero_scan_data, &data, scan_data_t);
  829.     first = scan;
  830.     /* Skip introductions and multiplicators >= 1. */
  831.     while ((OP(first) == OPEN && (sawopen = 1)) ||
  832.         (OP(first) == BRANCH && OP(regnext(first)) != BRANCH) ||
  833.         (OP(first) == PLUS) ||
  834.         (OP(first) == MINMOD) ||
  835.         (regkind[(U8)OP(first)] == CURLY && ARG1(first) > 0) ) {
  836.         if (OP(first) == PLUS)
  837.             sawplus = 1;
  838.         else
  839.             first += regarglen[(U8)OP(first)];
  840.         first = NEXTOPER(first);
  841.     }
  842.  
  843.     /* Starting-point info. */
  844.       again:
  845.     if (OP(first) == EXACT);    /* Empty, get anchored substr later. */
  846.     else if (strchr(simple+2,OP(first)))
  847.         r->regstclass = first;
  848.     else if (regkind[(U8)OP(first)] == BOUND ||
  849.          regkind[(U8)OP(first)] == NBOUND)
  850.         r->regstclass = first;
  851.     else if (regkind[(U8)OP(first)] == BOL) {
  852.         r->reganch |= (OP(first) == MBOL ? ROPT_ANCH_MBOL: ROPT_ANCH_BOL);
  853.         first = NEXTOPER(first);
  854.         goto again;
  855.     }
  856.     else if (OP(first) == GPOS) {
  857.         r->reganch |= ROPT_ANCH_GPOS;
  858.         first = NEXTOPER(first);
  859.         goto again;
  860.     }
  861.     else if ((OP(first) == STAR &&
  862.         regkind[(U8)OP(NEXTOPER(first))] == ANY) &&
  863.         !(r->reganch & ROPT_ANCH) )
  864.     {
  865.         /* turn .* into ^.* with an implied $*=1 */
  866.         r->reganch |= ROPT_ANCH_BOL | ROPT_IMPLICIT;
  867.         first = NEXTOPER(first);
  868.         goto again;
  869.     }
  870.     if (sawplus && (!sawopen || !PL_regsawback))
  871.         r->reganch |= ROPT_SKIP;    /* x+ must match 1st of run */
  872.  
  873.     /* Scan is after the zeroth branch, first is atomic matcher. */
  874.     DEBUG_r(PerlIO_printf(Perl_debug_log, "first at %d\n", 
  875.                   first - scan + 1));
  876.     /*
  877.     * If there's something expensive in the r.e., find the
  878.     * longest literal string that must appear and make it the
  879.     * regmust.  Resolve ties in favor of later strings, since
  880.     * the regstart check works with the beginning of the r.e.
  881.     * and avoiding duplication strengthens checking.  Not a
  882.     * strong reason, but sufficient in the absence of others.
  883.     * [Now we resolve ties in favor of the earlier string if
  884.     * it happens that c_offset_min has been invalidated, since the
  885.     * earlier string may buy us something the later one won't.]
  886.     */
  887.     minlen = 0;
  888.  
  889.     data.longest_fixed = newSVpv("",0);
  890.     data.longest_float = newSVpv("",0);
  891.     data.last_found = newSVpv("",0);
  892.     data.longest = &(data.longest_fixed);
  893.     first = scan;
  894.     
  895.     minlen = study_chunk(&first, &fake, scan + PL_regsize, /* Up to end */
  896.                  &data, SCF_DO_SUBSTR);
  897.     if ( PL_regnpar == 1 && data.longest == &(data.longest_fixed)
  898.          && data.last_start_min == 0 && data.last_end > 0 
  899.          && !PL_seen_zerolen
  900.          && (!(PL_regseen & REG_SEEN_GPOS) || (r->reganch & ROPT_ANCH_GPOS)))
  901.         r->reganch |= ROPT_CHECK_ALL;
  902.     scan_commit(&data);
  903.     SvREFCNT_dec(data.last_found);
  904.  
  905.     longest_float_length = SvCUR(data.longest_float);
  906.     if (longest_float_length
  907.         || (data.flags & SF_FL_BEFORE_EOL
  908.         && (!(data.flags & SF_FL_BEFORE_MEOL)
  909.             || (PL_regflags & PMf_MULTILINE)))) {
  910.         if (SvCUR(data.longest_fixed) 
  911.         && data.offset_fixed == data.offset_float_min)
  912.         goto remove;        /* Like in (a)+. */
  913.         
  914.         r->float_substr = data.longest_float;
  915.         r->float_min_offset = data.offset_float_min;
  916.         r->float_max_offset = data.offset_float_max;
  917.         fbm_compile(r->float_substr, 0);
  918.         BmUSEFUL(r->float_substr) = 100;
  919.         if (data.flags & SF_FL_BEFORE_EOL /* Cannot have SEOL and MULTI */
  920.         && (!(data.flags & SF_FL_BEFORE_MEOL)
  921.             || (PL_regflags & PMf_MULTILINE))) 
  922.         SvTAIL_on(r->float_substr);
  923.     } else {
  924.       remove:
  925.         r->float_substr = Nullsv;
  926.         SvREFCNT_dec(data.longest_float);
  927.         longest_float_length = 0;
  928.     }
  929.  
  930.     longest_fixed_length = SvCUR(data.longest_fixed);
  931.     if (longest_fixed_length
  932.         || (data.flags & SF_FIX_BEFORE_EOL /* Cannot have SEOL and MULTI */
  933.         && (!(data.flags & SF_FIX_BEFORE_MEOL)
  934.             || (PL_regflags & PMf_MULTILINE)))) {
  935.         r->anchored_substr = data.longest_fixed;
  936.         r->anchored_offset = data.offset_fixed;
  937.         fbm_compile(r->anchored_substr, 0);
  938.         BmUSEFUL(r->anchored_substr) = 100;
  939.         if (data.flags & SF_FIX_BEFORE_EOL /* Cannot have SEOL and MULTI */
  940.         && (!(data.flags & SF_FIX_BEFORE_MEOL)
  941.             || (PL_regflags & PMf_MULTILINE)))
  942.         SvTAIL_on(r->anchored_substr);
  943.     } else {
  944.         r->anchored_substr = Nullsv;
  945.         SvREFCNT_dec(data.longest_fixed);
  946.         longest_fixed_length = 0;
  947.     }
  948.  
  949.     /* A temporary algorithm prefers floated substr to fixed one to dig more info. */
  950.     if (longest_fixed_length > longest_float_length) {
  951.         r->check_substr = r->anchored_substr;
  952.         r->check_offset_min = r->check_offset_max = r->anchored_offset;
  953.         if (r->reganch & ROPT_ANCH_SINGLE)
  954.         r->reganch |= ROPT_NOSCAN;
  955.     } else {
  956.         r->check_substr = r->float_substr;
  957.         r->check_offset_min = data.offset_float_min;
  958.         r->check_offset_max = data.offset_float_max;
  959.     }
  960.     } else {
  961.     /* Several toplevels. Best we can is to set minlen. */
  962.     I32 fake;
  963.     
  964.     DEBUG_r(PerlIO_printf(Perl_debug_log, "\n"));
  965.     scan = r->program + 1;
  966.     minlen = study_chunk(&scan, &fake, scan + PL_regsize, NULL, 0);
  967.     r->check_substr = r->anchored_substr = r->float_substr = Nullsv;
  968.     }
  969.  
  970.     r->minlen = minlen;
  971.     if (PL_regseen & REG_SEEN_GPOS) 
  972.     r->reganch |= ROPT_GPOS_SEEN;
  973.     if (PL_regseen & REG_SEEN_LOOKBEHIND)
  974.     r->reganch |= ROPT_LOOKBEHIND_SEEN;
  975.     if (PL_regseen & REG_SEEN_EVAL)
  976.     r->reganch |= ROPT_EVAL_SEEN;
  977.     Newz(1002, r->startp, PL_regnpar, char*);
  978.     Newz(1002, r->endp, PL_regnpar, char*);
  979.     DEBUG_r(regdump(r));
  980.     return(r);
  981. }
  982.  
  983. /*
  984.  - reg - regular expression, i.e. main body or parenthesized thing
  985.  *
  986.  * Caller must absorb opening parenthesis.
  987.  *
  988.  * Combining parenthesis handling with the base level of regular expression
  989.  * is a trifle forced, but the need to tie the tails of the branches to what
  990.  * follows makes it hard to avoid.
  991.  */
  992. STATIC regnode *
  993. reg(I32 paren, I32 *flagp)
  994.     /* paren: Parenthesized? 0=top, 1=(, inside: changed to letter. */
  995. {
  996.     dTHR;
  997.     register regnode *ret;        /* Will be the head of the group. */
  998.     register regnode *br;
  999.     register regnode *lastbr;
  1000.     register regnode *ender = 0;
  1001.     register I32 parno = 0;
  1002.     I32 flags, oregflags = PL_regflags, have_branch = 0, open = 0;
  1003.     char c;
  1004.  
  1005.     *flagp = 0;                /* Tentatively. */
  1006.  
  1007.     /* Make an OPEN node, if parenthesized. */
  1008.     if (paren) {
  1009.     if (*PL_regcomp_parse == '?') {
  1010.         U16 posflags = 0, negflags = 0;
  1011.         U16 *flagsp = &posflags;
  1012.  
  1013.         PL_regcomp_parse++;
  1014.         paren = *PL_regcomp_parse++;
  1015.         ret = NULL;            /* For look-ahead/behind. */
  1016.         switch (paren) {
  1017.         case '<':
  1018.         PL_regseen |= REG_SEEN_LOOKBEHIND;
  1019.         if (*PL_regcomp_parse == '!') 
  1020.             paren = ',';
  1021.         if (*PL_regcomp_parse != '=' && *PL_regcomp_parse != '!') 
  1022.             goto unknown;
  1023.         PL_regcomp_parse++;
  1024.         case '=':
  1025.         case '!':
  1026.         PL_seen_zerolen++;
  1027.         case ':':
  1028.         case '>':
  1029.         break;
  1030.         case '$':
  1031.         case '@':
  1032.         FAIL2("Sequence (?%c...) not implemented", (int)paren);
  1033.         break;
  1034.         case '#':
  1035.         while (*PL_regcomp_parse && *PL_regcomp_parse != ')')
  1036.             PL_regcomp_parse++;
  1037.         if (*PL_regcomp_parse != ')')
  1038.             FAIL("Sequence (?#... not terminated");
  1039.         nextchar();
  1040.         *flagp = TRYAGAIN;
  1041.         return NULL;
  1042.         case '{':
  1043.         {
  1044.         dTHR;
  1045.         I32 count = 1, n = 0;
  1046.         char c;
  1047.         char *s = PL_regcomp_parse;
  1048.         SV *sv;
  1049.         OP_4tree *sop, *rop;
  1050.  
  1051.         PL_seen_zerolen++;
  1052.         PL_regseen |= REG_SEEN_EVAL;
  1053.         while (count && (c = *PL_regcomp_parse)) {
  1054.             if (c == '\\' && PL_regcomp_parse[1])
  1055.             PL_regcomp_parse++;
  1056.             else if (c == '{') 
  1057.             count++;
  1058.             else if (c == '}') 
  1059.             count--;
  1060.             PL_regcomp_parse++;
  1061.         }
  1062.         if (*PL_regcomp_parse != ')')
  1063.             FAIL("Sequence (?{...}) not terminated or not {}-balanced");
  1064.         if (!SIZE_ONLY) {
  1065.             AV *av;
  1066.             
  1067.             if (PL_regcomp_parse - 1 - s) 
  1068.             sv = newSVpv(s, PL_regcomp_parse - 1 - s);
  1069.             else
  1070.             sv = newSVpv("", 0);
  1071.  
  1072.             rop = sv_compile_2op(sv, &sop, "re", &av);
  1073.  
  1074.             n = add_data(3, "nso");
  1075.             PL_regcomp_rx->data->data[n] = (void*)rop;
  1076.             PL_regcomp_rx->data->data[n+1] = (void*)av;
  1077.             PL_regcomp_rx->data->data[n+2] = (void*)sop;
  1078.             SvREFCNT_dec(sv);
  1079.         } else {        /* First pass */
  1080.             if (PL_reginterp_cnt < ++PL_seen_evals && PL_curcop != &PL_compiling)
  1081.             /* No compiled RE interpolated, has runtime
  1082.                components ===> unsafe.  */
  1083.             FAIL("Eval-group not allowed at runtime, use re 'eval'");
  1084.             if (PL_tainted)
  1085.             FAIL("Eval-group in insecure regular expression");
  1086.         }
  1087.         
  1088.         nextchar();
  1089.         return reganode(EVAL, n);
  1090.         }
  1091.         case '(':
  1092.         {
  1093.         if (PL_regcomp_parse[0] == '?') {
  1094.             if (PL_regcomp_parse[1] == '=' || PL_regcomp_parse[1] == '!' 
  1095.             || PL_regcomp_parse[1] == '<' 
  1096.             || PL_regcomp_parse[1] == '{') { /* Lookahead or eval. */
  1097.             I32 flag;
  1098.             
  1099.             ret = reg_node(LOGICAL);
  1100.             regtail(ret, reg(1, &flag));
  1101.             goto insert_if;
  1102.             } 
  1103.         } else if (PL_regcomp_parse[0] >= '1' && PL_regcomp_parse[0] <= '9' ) {
  1104.             parno = atoi(PL_regcomp_parse++);
  1105.  
  1106.             while (isDIGIT(*PL_regcomp_parse))
  1107.             PL_regcomp_parse++;
  1108.             ret = reganode(GROUPP, parno);
  1109.             if ((c = *nextchar()) != ')')
  1110.             FAIL2("Switch (?(number%c not recognized", c);
  1111.           insert_if:
  1112.             regtail(ret, reganode(IFTHEN, 0));
  1113.             br = regbranch(&flags, 1);
  1114.             if (br == NULL)
  1115.             br = reganode(LONGJMP, 0);
  1116.             else
  1117.             regtail(br, reganode(LONGJMP, 0));
  1118.             c = *nextchar();
  1119.             if (c == '|') {
  1120.             lastbr = reganode(IFTHEN, 0); /* Fake one for optimizer. */
  1121.             regbranch(&flags, 1);
  1122.             regtail(ret, lastbr);
  1123.             c = *nextchar();
  1124.             } else
  1125.             lastbr = NULL;
  1126.             if (c != ')')
  1127.             FAIL("Switch (?(condition)... contains too many branches");
  1128.             ender = reg_node(TAIL);
  1129.             regtail(br, ender);
  1130.             if (lastbr) {
  1131.             regtail(lastbr, ender);
  1132.             regtail(NEXTOPER(NEXTOPER(lastbr)), ender);
  1133.             } else
  1134.             regtail(ret, ender);
  1135.             return ret;
  1136.         } else {
  1137.             FAIL2("Unknown condition for (?(%.2s", PL_regcomp_parse);
  1138.         }
  1139.         }
  1140.             case 0:
  1141.                 FAIL("Sequence (? incomplete");
  1142.                 break;
  1143.         default:
  1144.         --PL_regcomp_parse;
  1145.           parse_flags:
  1146.         while (*PL_regcomp_parse && strchr("iogcmsx", *PL_regcomp_parse)) {
  1147.             if (*PL_regcomp_parse != 'o')
  1148.             pmflag(flagsp, *PL_regcomp_parse);
  1149.             ++PL_regcomp_parse;
  1150.         }
  1151.         if (*PL_regcomp_parse == '-') {
  1152.             flagsp = &negflags;
  1153.             ++PL_regcomp_parse;
  1154.             goto parse_flags;
  1155.         }
  1156.         PL_regflags |= posflags;
  1157.         PL_regflags &= ~negflags;
  1158.         if (*PL_regcomp_parse == ':') {
  1159.             PL_regcomp_parse++;
  1160.             paren = ':';
  1161.             break;
  1162.         }        
  1163.           unknown:
  1164.         if (*PL_regcomp_parse != ')')
  1165.             FAIL2("Sequence (?%c...) not recognized", *PL_regcomp_parse);
  1166.         nextchar();
  1167.         *flagp = TRYAGAIN;
  1168.         return NULL;
  1169.         }
  1170.     }
  1171.     else {
  1172.         parno = PL_regnpar;
  1173.         PL_regnpar++;
  1174.         ret = reganode(OPEN, parno);
  1175.         open = 1;
  1176.     }
  1177.     } else
  1178.     ret = NULL;
  1179.  
  1180.     /* Pick up the branches, linking them together. */
  1181.     br = regbranch(&flags, 1);
  1182.     if (br == NULL)
  1183.     return(NULL);
  1184.     if (*PL_regcomp_parse == '|') {
  1185.     if (!SIZE_ONLY && PL_extralen) {
  1186.         reginsert(BRANCHJ, br);
  1187.     } else
  1188.         reginsert(BRANCH, br);
  1189.     have_branch = 1;
  1190.     if (SIZE_ONLY)
  1191.         PL_extralen += 1;        /* For BRANCHJ-BRANCH. */
  1192.     } else if (paren == ':') {
  1193.     *flagp |= flags&SIMPLE;
  1194.     }
  1195.     if (open) {                /* Starts with OPEN. */
  1196.     regtail(ret, br);        /* OPEN -> first. */
  1197.     } else if (paren != '?')        /* Not Conditional */
  1198.     ret = br;
  1199.     if (flags&HASWIDTH)
  1200.     *flagp |= HASWIDTH;
  1201.     *flagp |= flags&SPSTART;
  1202.     lastbr = br;
  1203.     while (*PL_regcomp_parse == '|') {
  1204.     if (!SIZE_ONLY && PL_extralen) {
  1205.         ender = reganode(LONGJMP,0);
  1206.         regtail(NEXTOPER(NEXTOPER(lastbr)), ender); /* Append to the previous. */
  1207.     }
  1208.     if (SIZE_ONLY)
  1209.         PL_extralen += 2;        /* Account for LONGJMP. */
  1210.     nextchar();
  1211.     br = regbranch(&flags, 0);
  1212.     if (br == NULL)
  1213.         return(NULL);
  1214.     regtail(lastbr, br);        /* BRANCH -> BRANCH. */
  1215.     lastbr = br;
  1216.     if (flags&HASWIDTH)
  1217.         *flagp |= HASWIDTH;
  1218.     *flagp |= flags&SPSTART;
  1219.     }
  1220.  
  1221.     if (have_branch || paren != ':') {
  1222.     /* Make a closing node, and hook it on the end. */
  1223.     switch (paren) {
  1224.     case ':':
  1225.         ender = reg_node(TAIL);
  1226.         break;
  1227.     case 1:
  1228.         ender = reganode(CLOSE, parno);
  1229.         break;
  1230.     case '<':
  1231.     case ',':
  1232.     case '=':
  1233.     case '!':
  1234.         *flagp &= ~HASWIDTH;
  1235.         /* FALL THROUGH */
  1236.     case '>':
  1237.         ender = reg_node(SUCCEED);
  1238.         break;
  1239.     case 0:
  1240.         ender = reg_node(END);
  1241.         break;
  1242.     }
  1243.     regtail(lastbr, ender);
  1244.  
  1245.     if (have_branch) {
  1246.         /* Hook the tails of the branches to the closing node. */
  1247.         for (br = ret; br != NULL; br = regnext(br)) {
  1248.         regoptail(br, ender);
  1249.         }
  1250.     }
  1251.     }
  1252.  
  1253.     {
  1254.     char *p;
  1255.     static char parens[] = "=!<,>";
  1256.  
  1257.     if (paren && (p = strchr(parens, paren))) {
  1258.         int node = ((p - parens) % 2) ? UNLESSM : IFMATCH;
  1259.         int flag = (p - parens) > 1;
  1260.  
  1261.         if (paren == '>')
  1262.         node = SUSPEND, flag = 0;
  1263.         reginsert(node,ret);
  1264.         ret->flags = flag;
  1265.         regtail(ret, reg_node(TAIL));
  1266.     }
  1267.     }
  1268.  
  1269.     /* Check for proper termination. */
  1270.     if (paren && (PL_regcomp_parse >= PL_regxend || *nextchar() != ')')) {
  1271.     FAIL("unmatched () in regexp");
  1272.     } else if (!paren && PL_regcomp_parse < PL_regxend) {
  1273.     if (*PL_regcomp_parse == ')') {
  1274.         FAIL("unmatched () in regexp");
  1275.     } else
  1276.         FAIL("junk on end of regexp");    /* "Can't happen". */
  1277.     /* NOTREACHED */
  1278.     }
  1279.     if (paren != 0) {
  1280.     PL_regflags = oregflags;
  1281.     }
  1282.  
  1283.     return(ret);
  1284. }
  1285.  
  1286. /*
  1287.  - regbranch - one alternative of an | operator
  1288.  *
  1289.  * Implements the concatenation operator.
  1290.  */
  1291. STATIC regnode *
  1292. regbranch(I32 *flagp, I32 first)
  1293. {
  1294.     dTHR;
  1295.     register regnode *ret;
  1296.     register regnode *chain = NULL;
  1297.     register regnode *latest;
  1298.     I32 flags = 0, c = 0;
  1299.  
  1300.     if (first) 
  1301.     ret = NULL;
  1302.     else {
  1303.     if (!SIZE_ONLY && PL_extralen) 
  1304.         ret = reganode(BRANCHJ,0);
  1305.     else
  1306.         ret = reg_node(BRANCH);
  1307.     }
  1308.     
  1309.     if (!first && SIZE_ONLY) 
  1310.     PL_extralen += 1;            /* BRANCHJ */
  1311.     
  1312.     *flagp = WORST;            /* Tentatively. */
  1313.  
  1314.     PL_regcomp_parse--;
  1315.     nextchar();
  1316.     while (PL_regcomp_parse < PL_regxend && *PL_regcomp_parse != '|' && *PL_regcomp_parse != ')') {
  1317.     flags &= ~TRYAGAIN;
  1318.     latest = regpiece(&flags);
  1319.     if (latest == NULL) {
  1320.         if (flags & TRYAGAIN)
  1321.         continue;
  1322.         return(NULL);
  1323.     } else if (ret == NULL)
  1324.         ret = latest;
  1325.     *flagp |= flags&HASWIDTH;
  1326.     if (chain == NULL)     /* First piece. */
  1327.         *flagp |= flags&SPSTART;
  1328.     else {
  1329.         PL_regnaughty++;
  1330.         regtail(chain, latest);
  1331.     }
  1332.     chain = latest;
  1333.     c++;
  1334.     }
  1335.     if (chain == NULL) {    /* Loop ran zero times. */
  1336.     chain = reg_node(NOTHING);
  1337.     if (ret == NULL)
  1338.         ret = chain;
  1339.     }
  1340.     if (c == 1) {
  1341.     *flagp |= flags&SIMPLE;
  1342.     }
  1343.  
  1344.     return(ret);
  1345. }
  1346.  
  1347. /*
  1348.  - regpiece - something followed by possible [*+?]
  1349.  *
  1350.  * Note that the branching code sequences used for ? and the general cases
  1351.  * of * and + are somewhat optimized:  they use the same NOTHING node as
  1352.  * both the endmarker for their branch list and the body of the last branch.
  1353.  * It might seem that this node could be dispensed with entirely, but the
  1354.  * endmarker role is not redundant.
  1355.  */
  1356. STATIC regnode *
  1357. regpiece(I32 *flagp)
  1358. {
  1359.     dTHR;
  1360.     register regnode *ret;
  1361.     register char op;
  1362.     register char *next;
  1363.     I32 flags;
  1364.     char *origparse = PL_regcomp_parse;
  1365.     char *maxpos;
  1366.     I32 min;
  1367.     I32 max = REG_INFTY;
  1368.  
  1369.     ret = regatom(&flags);
  1370.     if (ret == NULL) {
  1371.     if (flags & TRYAGAIN)
  1372.         *flagp |= TRYAGAIN;
  1373.     return(NULL);
  1374.     }
  1375.  
  1376.     op = *PL_regcomp_parse;
  1377.  
  1378.     if (op == '{' && regcurly(PL_regcomp_parse)) {
  1379.     next = PL_regcomp_parse + 1;
  1380.     maxpos = Nullch;
  1381.     while (isDIGIT(*next) || *next == ',') {
  1382.         if (*next == ',') {
  1383.         if (maxpos)
  1384.             break;
  1385.         else
  1386.             maxpos = next;
  1387.         }
  1388.         next++;
  1389.     }
  1390.     if (*next == '}') {        /* got one */
  1391.         if (!maxpos)
  1392.         maxpos = next;
  1393.         PL_regcomp_parse++;
  1394.         min = atoi(PL_regcomp_parse);
  1395.         if (*maxpos == ',')
  1396.         maxpos++;
  1397.         else
  1398.         maxpos = PL_regcomp_parse;
  1399.         max = atoi(maxpos);
  1400.         if (!max && *maxpos != '0')
  1401.         max = REG_INFTY;        /* meaning "infinity" */
  1402.         else if (max >= REG_INFTY)
  1403.         FAIL2("Quantifier in {,} bigger than %d", REG_INFTY - 1);
  1404.         PL_regcomp_parse = next;
  1405.         nextchar();
  1406.  
  1407.     do_curly:
  1408.         if ((flags&SIMPLE)) {
  1409.         PL_regnaughty += 2 + PL_regnaughty / 2;
  1410.         reginsert(CURLY, ret);
  1411.         }
  1412.         else {
  1413.         PL_regnaughty += 4 + PL_regnaughty;    /* compound interest */
  1414.         regtail(ret, reg_node(WHILEM));
  1415.         if (!SIZE_ONLY && PL_extralen) {
  1416.             reginsert(LONGJMP,ret);
  1417.             reginsert(NOTHING,ret);
  1418.             NEXT_OFF(ret) = 3;    /* Go over LONGJMP. */
  1419.         }
  1420.         reginsert(CURLYX,ret);
  1421.         if (!SIZE_ONLY && PL_extralen)
  1422.             NEXT_OFF(ret) = 3;    /* Go over NOTHING to LONGJMP. */
  1423.         regtail(ret, reg_node(NOTHING));
  1424.         if (SIZE_ONLY)
  1425.             PL_extralen += 3;
  1426.         }
  1427.         ret->flags = 0;
  1428.  
  1429.         if (min > 0)
  1430.         *flagp = WORST;
  1431.         if (max > 0)
  1432.         *flagp |= HASWIDTH;
  1433.         if (max && max < min)
  1434.         FAIL("Can't do {n,m} with n > m");
  1435.         if (!SIZE_ONLY) {
  1436.         ARG1_SET(ret, min);
  1437.         ARG2_SET(ret, max);
  1438.         }
  1439.  
  1440.         goto nest_check;
  1441.     }
  1442.     }
  1443.  
  1444.     if (!ISMULT1(op)) {
  1445.     *flagp = flags;
  1446.     return(ret);
  1447.     }
  1448.  
  1449. #if 0                /* Now runtime fix should be reliable. */
  1450.     if (!(flags&HASWIDTH) && op != '?')
  1451.       FAIL("regexp *+ operand could be empty");
  1452. #endif 
  1453.  
  1454.     nextchar();
  1455.  
  1456.     *flagp = (op != '+') ? (WORST|SPSTART|HASWIDTH) : (WORST|HASWIDTH);
  1457.  
  1458.     if (op == '*' && (flags&SIMPLE)) {
  1459.     reginsert(STAR, ret);
  1460.     ret->flags = 0;
  1461.     PL_regnaughty += 4;
  1462.     }
  1463.     else if (op == '*') {
  1464.     min = 0;
  1465.     goto do_curly;
  1466.     } else if (op == '+' && (flags&SIMPLE)) {
  1467.     reginsert(PLUS, ret);
  1468.     ret->flags = 0;
  1469.     PL_regnaughty += 3;
  1470.     }
  1471.     else if (op == '+') {
  1472.     min = 1;
  1473.     goto do_curly;
  1474.     } else if (op == '?') {
  1475.     min = 0; max = 1;
  1476.     goto do_curly;
  1477.     }
  1478.   nest_check:
  1479.     if (PL_dowarn && !SIZE_ONLY && !(flags&HASWIDTH) && max > 10000) {
  1480.     warn("%.*s matches null string many times",
  1481.         PL_regcomp_parse - origparse, origparse);
  1482.     }
  1483.  
  1484.     if (*PL_regcomp_parse == '?') {
  1485.     nextchar();
  1486.     reginsert(MINMOD, ret);
  1487.     regtail(ret, ret + NODE_STEP_REGNODE);
  1488.     }
  1489.     if (ISMULT2(PL_regcomp_parse))
  1490.     FAIL("nested *?+ in regexp");
  1491.  
  1492.     return(ret);
  1493. }
  1494.  
  1495. /*
  1496.  - regatom - the lowest level
  1497.  *
  1498.  * Optimization:  gobbles an entire sequence of ordinary characters so that
  1499.  * it can turn them into a single node, which is smaller to store and
  1500.  * faster to run.  Backslashed characters are exceptions, each becoming a
  1501.  * separate node; the code is simpler that way and it's not worth fixing.
  1502.  *
  1503.  * [Yes, it is worth fixing, some scripts can run twice the speed.]
  1504.  */
  1505. STATIC regnode *
  1506. regatom(I32 *flagp)
  1507. {
  1508.     dTHR;
  1509.     register regnode *ret = 0;
  1510.     I32 flags;
  1511.  
  1512.     *flagp = WORST;        /* Tentatively. */
  1513.  
  1514. tryagain:
  1515.     switch (*PL_regcomp_parse) {
  1516.     case '^':
  1517.     PL_seen_zerolen++;
  1518.     nextchar();
  1519.     if (PL_regflags & PMf_MULTILINE)
  1520.         ret = reg_node(MBOL);
  1521.     else if (PL_regflags & PMf_SINGLELINE)
  1522.         ret = reg_node(SBOL);
  1523.     else
  1524.         ret = reg_node(BOL);
  1525.     break;
  1526.     case '$':
  1527.     if (PL_regcomp_parse[1]) 
  1528.         PL_seen_zerolen++;
  1529.     nextchar();
  1530.     if (PL_regflags & PMf_MULTILINE)
  1531.         ret = reg_node(MEOL);
  1532.     else if (PL_regflags & PMf_SINGLELINE)
  1533.         ret = reg_node(SEOL);
  1534.     else
  1535.         ret = reg_node(EOL);
  1536.     break;
  1537.     case '.':
  1538.     nextchar();
  1539.     if (PL_regflags & PMf_SINGLELINE)
  1540.         ret = reg_node(SANY);
  1541.     else
  1542.         ret = reg_node(ANY);
  1543.     PL_regnaughty++;
  1544.     *flagp |= HASWIDTH|SIMPLE;
  1545.     break;
  1546.     case '[':
  1547.     PL_regcomp_parse++;
  1548.     ret = regclass();
  1549.     *flagp |= HASWIDTH|SIMPLE;
  1550.     break;
  1551.     case '(':
  1552.     nextchar();
  1553.     ret = reg(1, &flags);
  1554.     if (ret == NULL) {
  1555.         if (flags & TRYAGAIN)
  1556.             goto tryagain;
  1557.         return(NULL);
  1558.     }
  1559.     *flagp |= flags&(HASWIDTH|SPSTART|SIMPLE);
  1560.     break;
  1561.     case '|':
  1562.     case ')':
  1563.     if (flags & TRYAGAIN) {
  1564.         *flagp |= TRYAGAIN;
  1565.         return NULL;
  1566.     }
  1567.     FAIL2("internal urp in regexp at /%s/", PL_regcomp_parse);
  1568.                 /* Supposed to be caught earlier. */
  1569.     break;
  1570.     case '{':
  1571.     if (!regcurly(PL_regcomp_parse)) {
  1572.         PL_regcomp_parse++;
  1573.         goto defchar;
  1574.     }
  1575.     /* FALL THROUGH */
  1576.     case '?':
  1577.     case '+':
  1578.     case '*':
  1579.     FAIL("?+*{} follows nothing in regexp");
  1580.     break;
  1581.     case '\\':
  1582.     switch (*++PL_regcomp_parse) {
  1583.     case 'A':
  1584.         PL_seen_zerolen++;
  1585.         ret = reg_node(SBOL);
  1586.         *flagp |= SIMPLE;
  1587.         nextchar();
  1588.         break;
  1589.     case 'G':
  1590.         ret = reg_node(GPOS);
  1591.         PL_regseen |= REG_SEEN_GPOS;
  1592.         *flagp |= SIMPLE;
  1593.         nextchar();
  1594.         break;
  1595.     case 'Z':
  1596.         ret = reg_node(SEOL);
  1597.         *flagp |= SIMPLE;
  1598.         nextchar();
  1599.         break;
  1600.     case 'z':
  1601.         ret = reg_node(EOS);
  1602.         *flagp |= SIMPLE;
  1603.         PL_seen_zerolen++;        /* Do not optimize RE away */
  1604.         nextchar();
  1605.         break;
  1606.     case 'w':
  1607.         ret = reg_node((PL_regflags & PMf_LOCALE) ? ALNUML : ALNUM);
  1608.         *flagp |= HASWIDTH|SIMPLE;
  1609.         nextchar();
  1610.         break;
  1611.     case 'W':
  1612.         ret = reg_node((PL_regflags & PMf_LOCALE) ? NALNUML : NALNUM);
  1613.         *flagp |= HASWIDTH|SIMPLE;
  1614.         nextchar();
  1615.         break;
  1616.     case 'b':
  1617.         PL_seen_zerolen++;
  1618.         ret = reg_node((PL_regflags & PMf_LOCALE) ? BOUNDL : BOUND);
  1619.         *flagp |= SIMPLE;
  1620.         nextchar();
  1621.         break;
  1622.     case 'B':
  1623.         PL_seen_zerolen++;
  1624.         ret = reg_node((PL_regflags & PMf_LOCALE) ? NBOUNDL : NBOUND);
  1625.         *flagp |= SIMPLE;
  1626.         nextchar();
  1627.         break;
  1628.     case 's':
  1629.         ret = reg_node((PL_regflags & PMf_LOCALE) ? SPACEL : SPACE);
  1630.         *flagp |= HASWIDTH|SIMPLE;
  1631.         nextchar();
  1632.         break;
  1633.     case 'S':
  1634.         ret = reg_node((PL_regflags & PMf_LOCALE) ? NSPACEL : NSPACE);
  1635.         *flagp |= HASWIDTH|SIMPLE;
  1636.         nextchar();
  1637.         break;
  1638.     case 'd':
  1639.         ret = reg_node(DIGIT);
  1640.         *flagp |= HASWIDTH|SIMPLE;
  1641.         nextchar();
  1642.         break;
  1643.     case 'D':
  1644.         ret = reg_node(NDIGIT);
  1645.         *flagp |= HASWIDTH|SIMPLE;
  1646.         nextchar();
  1647.         break;
  1648.     case 'n':
  1649.     case 'r':
  1650.     case 't':
  1651.     case 'f':
  1652.     case 'e':
  1653.     case 'a':
  1654.     case 'x':
  1655.     case 'c':
  1656.     case '0':
  1657.         goto defchar;
  1658.     case '1': case '2': case '3': case '4':
  1659.     case '5': case '6': case '7': case '8': case '9':
  1660.         {
  1661.         I32 num = atoi(PL_regcomp_parse);
  1662.  
  1663.         if (num > 9 && num >= PL_regnpar)
  1664.             goto defchar;
  1665.         else {
  1666.             if (!SIZE_ONLY && num > PL_regcomp_rx->nparens)
  1667.             FAIL("reference to nonexistent group");
  1668.             PL_regsawback = 1;
  1669.             ret = reganode((PL_regflags & PMf_FOLD)
  1670.                    ? ((PL_regflags & PMf_LOCALE) ? REFFL : REFF)
  1671.                    : REF, num);
  1672.             *flagp |= HASWIDTH;
  1673.             while (isDIGIT(*PL_regcomp_parse))
  1674.             PL_regcomp_parse++;
  1675.             PL_regcomp_parse--;
  1676.             nextchar();
  1677.         }
  1678.         }
  1679.         break;
  1680.     case '\0':
  1681.         if (PL_regcomp_parse >= PL_regxend)
  1682.         FAIL("trailing \\ in regexp");
  1683.         /* FALL THROUGH */
  1684.     default:
  1685.         goto defchar;
  1686.     }
  1687.     break;
  1688.  
  1689.     case '#':
  1690.     if (PL_regflags & PMf_EXTENDED) {
  1691.         while (PL_regcomp_parse < PL_regxend && *PL_regcomp_parse != '\n') PL_regcomp_parse++;
  1692.         if (PL_regcomp_parse < PL_regxend)
  1693.         goto tryagain;
  1694.     }
  1695.     /* FALL THROUGH */
  1696.  
  1697.     default: {
  1698.         register I32 len;
  1699.         register U8 ender;
  1700.         register char *p;
  1701.         char *oldp, *s;
  1702.         I32 numlen;
  1703.  
  1704.         PL_regcomp_parse++;
  1705.  
  1706.     defchar:
  1707.         ret = reg_node((PL_regflags & PMf_FOLD)
  1708.               ? ((PL_regflags & PMf_LOCALE) ? EXACTFL : EXACTF)
  1709.               : EXACT);
  1710.         s = (char *) OPERAND(ret);
  1711.         regc(0, s++);        /* save spot for len */
  1712.         for (len = 0, p = PL_regcomp_parse - 1;
  1713.           len < 127 && p < PL_regxend;
  1714.           len++)
  1715.         {
  1716.         oldp = p;
  1717.  
  1718.         if (PL_regflags & PMf_EXTENDED)
  1719.             p = regwhite(p, PL_regxend);
  1720.         switch (*p) {
  1721.         case '^':
  1722.         case '$':
  1723.         case '.':
  1724.         case '[':
  1725.         case '(':
  1726.         case ')':
  1727.         case '|':
  1728.             goto loopdone;
  1729.         case '\\':
  1730.             switch (*++p) {
  1731.             case 'A':
  1732.             case 'G':
  1733.             case 'Z':
  1734.             case 'z':
  1735.             case 'w':
  1736.             case 'W':
  1737.             case 'b':
  1738.             case 'B':
  1739.             case 's':
  1740.             case 'S':
  1741.             case 'd':
  1742.             case 'D':
  1743.             --p;
  1744.             goto loopdone;
  1745.             case 'n':
  1746.             ender = '\n';
  1747.             p++;
  1748.             break;
  1749.             case 'r':
  1750.             ender = '\r';
  1751.             p++;
  1752.             break;
  1753.             case 't':
  1754.             ender = '\t';
  1755.             p++;
  1756.             break;
  1757.             case 'f':
  1758.             ender = '\f';
  1759.             p++;
  1760.             break;
  1761.             case 'e':
  1762.             ender = '\033';
  1763.             p++;
  1764.             break;
  1765.             case 'a':
  1766.             ender = '\007';
  1767.             p++;
  1768.             break;
  1769.             case 'x':
  1770.             ender = scan_hex(++p, 2, &numlen);
  1771.             p += numlen;
  1772.             break;
  1773.             case 'c':
  1774.             p++;
  1775.             ender = UCHARAT(p++);
  1776.             ender = toCTRL(ender);
  1777.             break;
  1778.             case '0': case '1': case '2': case '3':case '4':
  1779.             case '5': case '6': case '7': case '8':case '9':
  1780.             if (*p == '0' ||
  1781.               (isDIGIT(p[1]) && atoi(p) >= PL_regnpar) ) {
  1782.                 ender = scan_oct(p, 3, &numlen);
  1783.                 p += numlen;
  1784.             }
  1785.             else {
  1786.                 --p;
  1787.                 goto loopdone;
  1788.             }
  1789.             break;
  1790.             case '\0':
  1791.             if (p >= PL_regxend)
  1792.                 FAIL("trailing \\ in regexp");
  1793.             /* FALL THROUGH */
  1794.             default:
  1795.             ender = *p++;
  1796.             break;
  1797.             }
  1798.             break;
  1799.         default:
  1800.             ender = *p++;
  1801.             break;
  1802.         }
  1803.         if (PL_regflags & PMf_EXTENDED)
  1804.             p = regwhite(p, PL_regxend);
  1805.         if (ISMULT2(p)) { /* Back off on ?+*. */
  1806.             if (len)
  1807.             p = oldp;
  1808.             else {
  1809.             len++;
  1810.             regc(ender, s++);
  1811.             }
  1812.             break;
  1813.         }
  1814.         regc(ender, s++);
  1815.         }
  1816.     loopdone:
  1817.         PL_regcomp_parse = p - 1;
  1818.         nextchar();
  1819.         if (len < 0)
  1820.         FAIL("internal disaster in regexp");
  1821.         if (len > 0)
  1822.         *flagp |= HASWIDTH;
  1823.         if (len == 1)
  1824.         *flagp |= SIMPLE;
  1825.         if (!SIZE_ONLY)
  1826.         *OPERAND(ret) = len;
  1827.         regc('\0', s++);
  1828.         if (SIZE_ONLY) {
  1829.         PL_regsize += (len + 2 + sizeof(regnode) - 1) / sizeof(regnode);
  1830.         } else {
  1831.         PL_regcode += (len + 2 + sizeof(regnode) - 1) / sizeof(regnode);
  1832.         }
  1833.     }
  1834.     break;
  1835.     }
  1836.  
  1837.     return(ret);
  1838. }
  1839.  
  1840. STATIC char *
  1841. regwhite(char *p, char *e)
  1842. {
  1843.     while (p < e) {
  1844.     if (isSPACE(*p))
  1845.         ++p;
  1846.     else if (*p == '#') {
  1847.         do {
  1848.         p++;
  1849.         } while (p < e && *p != '\n');
  1850.     }
  1851.     else
  1852.         break;
  1853.     }
  1854.     return p;
  1855. }
  1856.  
  1857. STATIC regnode *
  1858. regclass(void)
  1859. {
  1860.     dTHR;
  1861.     register char *opnd, *s;
  1862.     register I32 Class;
  1863.     register I32 lastclass = 1234;
  1864.     register I32 range = 0;
  1865.     register regnode *ret;
  1866.     register I32 def;
  1867.     I32 numlen;
  1868.  
  1869.     s = opnd = (char *) OPERAND(PL_regcode);
  1870.     ret = reg_node(ANYOF);
  1871.     for (Class = 0; Class < 33; Class++)
  1872.     regc(0, s++);
  1873.     if (*PL_regcomp_parse == '^') {    /* Complement of range. */
  1874.     PL_regnaughty++;
  1875.     PL_regcomp_parse++;
  1876.     if (!SIZE_ONLY)
  1877.         *opnd |= ANYOF_INVERT;
  1878.     }
  1879.     if (!SIZE_ONLY) {
  1880.      PL_regcode += ANY_SKIP;
  1881.     if (PL_regflags & PMf_FOLD)
  1882.         *opnd |= ANYOF_FOLD;
  1883.     if (PL_regflags & PMf_LOCALE)
  1884.         *opnd |= ANYOF_LOCALE;
  1885.     } else {
  1886.     PL_regsize += ANY_SKIP;
  1887.     }
  1888.     if (*PL_regcomp_parse == ']' || *PL_regcomp_parse == '-')
  1889.     goto skipcond;        /* allow 1st char to be ] or - */
  1890.     while (PL_regcomp_parse < PL_regxend && *PL_regcomp_parse != ']') {
  1891.        skipcond:
  1892.     Class = UCHARAT(PL_regcomp_parse++);
  1893.     if (Class == '[' && PL_regcomp_parse + 1 < PL_regxend &&
  1894.         /* I smell either [: or [= or [. -- POSIX has been here, right? */
  1895.         (*PL_regcomp_parse == ':' || *PL_regcomp_parse == '=' || *PL_regcomp_parse == '.')) {
  1896.         char  posixccc = *PL_regcomp_parse;
  1897.         char* posixccs = PL_regcomp_parse++;
  1898.         
  1899.         while (PL_regcomp_parse < PL_regxend && *PL_regcomp_parse != posixccc)
  1900.         PL_regcomp_parse++;
  1901.         if (PL_regcomp_parse == PL_regxend)
  1902.         /* Grandfather lone [:, [=, [. */
  1903.         PL_regcomp_parse = posixccs;
  1904.         else {
  1905.         PL_regcomp_parse++; /* skip over the posixccc */
  1906.         if (*PL_regcomp_parse == ']') {
  1907.             /* Not Implemented Yet.
  1908.              * (POSIX Extended Character Classes, that is)
  1909.              * The text between e.g. [: and :] would start
  1910.              * at posixccs + 1 and stop at regcomp_parse - 2. */
  1911.             if (PL_dowarn && !SIZE_ONLY)
  1912.             warn("Character class syntax [%c %c] is reserved for future extensions", posixccc, posixccc);
  1913.             PL_regcomp_parse++; /* skip over the ending ] */
  1914.         }
  1915.         }
  1916.     }
  1917.     if (Class == '\\') {
  1918.         Class = UCHARAT(PL_regcomp_parse++);
  1919.         switch (Class) {
  1920.         case 'w':
  1921.         if (!SIZE_ONLY) {
  1922.             if (PL_regflags & PMf_LOCALE)
  1923.             *opnd |= ANYOF_ALNUML;
  1924.             else {
  1925.             for (Class = 0; Class < 256; Class++)
  1926.                 if (isALNUM(Class))
  1927.                 ANYOF_SET(opnd, Class);
  1928.             }
  1929.         }
  1930.         lastclass = 1234;
  1931.         continue;
  1932.         case 'W':
  1933.         if (!SIZE_ONLY) {
  1934.             if (PL_regflags & PMf_LOCALE)
  1935.             *opnd |= ANYOF_NALNUML;
  1936.             else {
  1937.             for (Class = 0; Class < 256; Class++)
  1938.                 if (!isALNUM(Class))
  1939.                 ANYOF_SET(opnd, Class);
  1940.             }
  1941.         }
  1942.         lastclass = 1234;
  1943.         continue;
  1944.         case 's':
  1945.         if (!SIZE_ONLY) {
  1946.             if (PL_regflags & PMf_LOCALE)
  1947.             *opnd |= ANYOF_SPACEL;
  1948.             else {
  1949.             for (Class = 0; Class < 256; Class++)
  1950.                 if (isSPACE(Class))
  1951.                 ANYOF_SET(opnd, Class);
  1952.             }
  1953.         }
  1954.         lastclass = 1234;
  1955.         continue;
  1956.         case 'S':
  1957.         if (!SIZE_ONLY) {
  1958.             if (PL_regflags & PMf_LOCALE)
  1959.             *opnd |= ANYOF_NSPACEL;
  1960.             else {
  1961.             for (Class = 0; Class < 256; Class++)
  1962.                 if (!isSPACE(Class))
  1963.                 ANYOF_SET(opnd, Class);
  1964.             }
  1965.         }
  1966.         lastclass = 1234;
  1967.         continue;
  1968.         case 'd':
  1969.         if (!SIZE_ONLY) {
  1970.             for (Class = '0'; Class <= '9'; Class++)
  1971.             ANYOF_SET(opnd, Class);
  1972.         }
  1973.         lastclass = 1234;
  1974.         continue;
  1975.         case 'D':
  1976.         if (!SIZE_ONLY) {
  1977.             for (Class = 0; Class < '0'; Class++)
  1978.             ANYOF_SET(opnd, Class);
  1979.             for (Class = '9' + 1; Class < 256; Class++)
  1980.             ANYOF_SET(opnd, Class);
  1981.         }
  1982.         lastclass = 1234;
  1983.         continue;
  1984.         case 'n':
  1985.         Class = '\n';
  1986.         break;
  1987.         case 'r':
  1988.         Class = '\r';
  1989.         break;
  1990.         case 't':
  1991.         Class = '\t';
  1992.         break;
  1993.         case 'f':
  1994.         Class = '\f';
  1995.         break;
  1996.         case 'b':
  1997.         Class = '\b';
  1998.         break;
  1999.         case 'e':
  2000.         Class = '\033';
  2001.         break;
  2002.         case 'a':
  2003.         Class = '\007';
  2004.         break;
  2005.         case 'x':
  2006.         Class = scan_hex(PL_regcomp_parse, 2, &numlen);
  2007.         PL_regcomp_parse += numlen;
  2008.         break;
  2009.         case 'c':
  2010.         Class = UCHARAT(PL_regcomp_parse++);
  2011.         Class = toCTRL(Class);
  2012.         break;
  2013.         case '0': case '1': case '2': case '3': case '4':
  2014.         case '5': case '6': case '7': case '8': case '9':
  2015.         Class = scan_oct(--PL_regcomp_parse, 3, &numlen);
  2016.         PL_regcomp_parse += numlen;
  2017.         break;
  2018.         }
  2019.     }
  2020.     if (range) {
  2021.         if (lastclass > Class)
  2022.         FAIL("invalid [] range in regexp");
  2023.         range = 0;
  2024.     }
  2025.     else {
  2026.         lastclass = Class;
  2027.         if (*PL_regcomp_parse == '-' && PL_regcomp_parse+1 < PL_regxend &&
  2028.           PL_regcomp_parse[1] != ']') {
  2029.         PL_regcomp_parse++;
  2030.         range = 1;
  2031.         continue;    /* do it next time */
  2032.         }
  2033.     }
  2034.     if (!SIZE_ONLY) {
  2035.         for ( ; lastclass <= Class; lastclass++)
  2036.         ANYOF_SET(opnd, lastclass);
  2037.     }
  2038.     lastclass = Class;
  2039.     }
  2040.     if (*PL_regcomp_parse != ']')
  2041.     FAIL("unmatched [] in regexp");
  2042.     nextchar();
  2043.     /* optimize case-insensitive simple patterns (e.g. /[a-z]/i) */
  2044.     if (!SIZE_ONLY && (*opnd & (0xFF ^ ANYOF_INVERT)) == ANYOF_FOLD) {
  2045.     for (Class = 0; Class < 256; ++Class) {
  2046.         if (ANYOF_TEST(opnd, Class)) {
  2047.         I32 cf = fold[Class];
  2048.         ANYOF_SET(opnd, cf);
  2049.         }
  2050.     }
  2051.     *opnd &= ~ANYOF_FOLD;
  2052.     }
  2053.     /* optimize inverted simple patterns (e.g. [^a-z]) */
  2054.     if (!SIZE_ONLY && (*opnd & 0xFF) == ANYOF_INVERT) {
  2055.     for (Class = 0; Class < 32; ++Class)
  2056.         opnd[1 + Class] ^= 0xFF;
  2057.     *opnd = 0;
  2058.     }
  2059.     return ret;
  2060. }
  2061.  
  2062. STATIC char*
  2063. nextchar(void)
  2064. {
  2065.     dTHR;
  2066.     char* retval = PL_regcomp_parse++;
  2067.  
  2068.     for (;;) {
  2069.     if (*PL_regcomp_parse == '(' && PL_regcomp_parse[1] == '?' &&
  2070.         PL_regcomp_parse[2] == '#') {
  2071.         while (*PL_regcomp_parse && *PL_regcomp_parse != ')')
  2072.         PL_regcomp_parse++;
  2073.         PL_regcomp_parse++;
  2074.         continue;
  2075.     }
  2076.     if (PL_regflags & PMf_EXTENDED) {
  2077.         if (isSPACE(*PL_regcomp_parse)) {
  2078.         PL_regcomp_parse++;
  2079.         continue;
  2080.         }
  2081.         else if (*PL_regcomp_parse == '#') {
  2082.         while (*PL_regcomp_parse && *PL_regcomp_parse != '\n')
  2083.             PL_regcomp_parse++;
  2084.         PL_regcomp_parse++;
  2085.         continue;
  2086.         }
  2087.     }
  2088.     return retval;
  2089.     }
  2090. }
  2091.  
  2092. /*
  2093. - reg_node - emit a node
  2094. */
  2095. STATIC regnode *            /* Location. */
  2096. reg_node(U8 op)
  2097. {
  2098.     dTHR;
  2099.     register regnode *ret;
  2100.     register regnode *ptr;
  2101.  
  2102.     ret = PL_regcode;
  2103.     if (SIZE_ONLY) {
  2104.     SIZE_ALIGN(PL_regsize);
  2105.     PL_regsize += 1;
  2106.     return(ret);
  2107.     }
  2108.  
  2109.     NODE_ALIGN_FILL(ret);
  2110.     ptr = ret;
  2111.     FILL_ADVANCE_NODE(ptr, op);
  2112.     PL_regcode = ptr;
  2113.  
  2114.     return(ret);
  2115. }
  2116.  
  2117. /*
  2118. - reganode - emit a node with an argument
  2119. */
  2120. STATIC regnode *            /* Location. */
  2121. reganode(U8 op, U32 arg)
  2122. {
  2123.     dTHR;
  2124.     register regnode *ret;
  2125.     register regnode *ptr;
  2126.  
  2127.     ret = PL_regcode;
  2128.     if (SIZE_ONLY) {
  2129.     SIZE_ALIGN(PL_regsize);
  2130.     PL_regsize += 2;
  2131.     return(ret);
  2132.     }
  2133.  
  2134.     NODE_ALIGN_FILL(ret);
  2135.     ptr = ret;
  2136.     FILL_ADVANCE_NODE_ARG(ptr, op, arg);
  2137.     PL_regcode = ptr;
  2138.  
  2139.     return(ret);
  2140. }
  2141.  
  2142. /*
  2143. - regc - emit (if appropriate) a byte of code
  2144. */
  2145. STATIC void
  2146. regc(U8 b, char* s)
  2147. {
  2148.     dTHR;
  2149.     if (!SIZE_ONLY)
  2150.     *s = b;
  2151. }
  2152.  
  2153. /*
  2154. - reginsert - insert an operator in front of already-emitted operand
  2155. *
  2156. * Means relocating the operand.
  2157. */
  2158. STATIC void
  2159. reginsert(U8 op, regnode *opnd)
  2160. {
  2161.     dTHR;
  2162.     register regnode *src;
  2163.     register regnode *dst;
  2164.     register regnode *place;
  2165.     register int offset = regarglen[(U8)op];
  2166.     
  2167. /* (regkind[(U8)op] == CURLY ? EXTRA_STEP_2ARGS : 0); */
  2168.  
  2169.     if (SIZE_ONLY) {
  2170.     PL_regsize += NODE_STEP_REGNODE + offset;
  2171.     return;
  2172.     }
  2173.  
  2174.     src = PL_regcode;
  2175.     PL_regcode += NODE_STEP_REGNODE + offset;
  2176.     dst = PL_regcode;
  2177.     while (src > opnd)
  2178.     StructCopy(--src, --dst, regnode);
  2179.  
  2180.     place = opnd;        /* Op node, where operand used to be. */
  2181.     src = NEXTOPER(place);
  2182.     FILL_ADVANCE_NODE(place, op);
  2183.     Zero(src, offset, regnode);
  2184. }
  2185.  
  2186. /*
  2187. - regtail - set the next-pointer at the end of a node chain of p to val.
  2188. */
  2189. STATIC void
  2190. regtail(regnode *p, regnode *val)
  2191. {
  2192.     dTHR;
  2193.     register regnode *scan;
  2194.     register regnode *temp;
  2195.     register I32 offset;
  2196.  
  2197.     if (SIZE_ONLY)
  2198.     return;
  2199.  
  2200.     /* Find last node. */
  2201.     scan = p;
  2202.     for (;;) {
  2203.     temp = regnext(scan);
  2204.     if (temp == NULL)
  2205.         break;
  2206.     scan = temp;
  2207.     }
  2208.  
  2209.     if (reg_off_by_arg[OP(scan)]) {
  2210.     ARG_SET(scan, val - scan);
  2211.     } else {
  2212.     NEXT_OFF(scan) = val - scan;
  2213.     }
  2214. }
  2215.  
  2216. /*
  2217. - regoptail - regtail on operand of first argument; nop if operandless
  2218. */
  2219. STATIC void
  2220. regoptail(regnode *p, regnode *val)
  2221. {
  2222.     dTHR;
  2223.     /* "Operandless" and "op != BRANCH" are synonymous in practice. */
  2224.     if (p == NULL || SIZE_ONLY)
  2225.     return;
  2226.     if (regkind[(U8)OP(p)] == BRANCH) {
  2227.     regtail(NEXTOPER(p), val);
  2228.     } else if ( regkind[(U8)OP(p)] == BRANCHJ) {
  2229.     regtail(NEXTOPER(NEXTOPER(p)), val);
  2230.     } else
  2231.     return;
  2232. }
  2233.  
  2234. /*
  2235.  - regcurly - a little FSA that accepts {\d+,?\d*}
  2236.  */
  2237. STATIC I32
  2238. regcurly(register char *s)
  2239. {
  2240.     if (*s++ != '{')
  2241.     return FALSE;
  2242.     if (!isDIGIT(*s))
  2243.     return FALSE;
  2244.     while (isDIGIT(*s))
  2245.     s++;
  2246.     if (*s == ',')
  2247.     s++;
  2248.     while (isDIGIT(*s))
  2249.     s++;
  2250.     if (*s != '}')
  2251.     return FALSE;
  2252.     return TRUE;
  2253. }
  2254.  
  2255.  
  2256. STATIC regnode *
  2257. dumpuntil(regnode *start, regnode *node, regnode *last, SV* sv, I32 l)
  2258. {
  2259. #ifdef DEBUGGING
  2260.     register char op = EXACT;    /* Arbitrary non-END op. */
  2261.     register regnode *next, *onode;
  2262.  
  2263.     while (op != END && (!last || node < last)) {
  2264.     /* While that wasn't END last time... */
  2265.  
  2266.     NODE_ALIGN(node);
  2267.     op = OP(node);
  2268.     if (op == CLOSE)
  2269.         l--;    
  2270.     next = regnext(node);
  2271.     /* Where, what. */
  2272.     if (OP(node) == OPTIMIZED)
  2273.         goto after_print;
  2274.     regprop(sv, node);
  2275.     PerlIO_printf(Perl_debug_log, "%4d:%*s%s", node - start, 
  2276.               2*l + 1, "", SvPVX(sv));
  2277.     if (next == NULL)        /* Next ptr. */
  2278.         PerlIO_printf(Perl_debug_log, "(0)");
  2279.     else 
  2280.         PerlIO_printf(Perl_debug_log, "(%d)", next - start);
  2281.     (void)PerlIO_putc(Perl_debug_log, '\n');
  2282.       after_print:
  2283.     if (regkind[(U8)op] == BRANCHJ) {
  2284.         register regnode *nnode = (OP(next) == LONGJMP 
  2285.                        ? regnext(next) 
  2286.                        : next);
  2287.         if (last && nnode > last)
  2288.         nnode = last;
  2289.         node = dumpuntil(start, NEXTOPER(NEXTOPER(node)), nnode, sv, l + 1);
  2290.     } else if (regkind[(U8)op] == BRANCH) {
  2291.         node = dumpuntil(start, NEXTOPER(node), next, sv, l + 1);
  2292.     } else if ( op == CURLY) {   /* `next' might be very big: optimizer */
  2293.         node = dumpuntil(start, NEXTOPER(node) + EXTRA_STEP_2ARGS,
  2294.                  NEXTOPER(node) + EXTRA_STEP_2ARGS + 1, sv, l + 1);
  2295.     } else if (regkind[(U8)op] == CURLY && op != CURLYX) {
  2296.         node = dumpuntil(start, NEXTOPER(node) + EXTRA_STEP_2ARGS,
  2297.                  next, sv, l + 1);
  2298.     } else if ( op == PLUS || op == STAR) {
  2299.         node = dumpuntil(start, NEXTOPER(node), NEXTOPER(node) + 1, sv, l + 1);
  2300.     } else if (op == ANYOF) {
  2301.         node = NEXTOPER(node);
  2302.         node += ANY_SKIP;
  2303.     } else if (regkind[(U8)op] == EXACT) {
  2304.             /* Literal string, where present. */
  2305.         node += ((*OPERAND(node)) + 2 + sizeof(regnode) - 1) / sizeof(regnode);
  2306.         node = NEXTOPER(node);
  2307.     } else {
  2308.         node = NEXTOPER(node);
  2309.         node += regarglen[(U8)op];
  2310.     }
  2311.     if (op == CURLYX || op == OPEN)
  2312.         l++;
  2313.     else if (op == WHILEM)
  2314.         l--;
  2315.     }
  2316. #endif    /* DEBUGGING */
  2317.     return node;
  2318. }
  2319.  
  2320. /*
  2321.  - regdump - dump a regexp onto Perl_debug_log in vaguely comprehensible form
  2322.  */
  2323. void
  2324. regdump(regexp *r)
  2325. {
  2326. #ifdef DEBUGGING
  2327.     dTHR;
  2328.     SV *sv = sv_newmortal();
  2329.  
  2330.     (void)dumpuntil(r->program, r->program + 1, NULL, sv, 0);
  2331.  
  2332.     /* Header fields of interest. */
  2333.     if (r->anchored_substr)
  2334.     PerlIO_printf(Perl_debug_log, "anchored `%s%s%s'%s at %d ", 
  2335.               PL_colors[0],
  2336.               SvPVX(r->anchored_substr), 
  2337.               PL_colors[1],
  2338.               SvTAIL(r->anchored_substr) ? "$" : "",
  2339.               r->anchored_offset);
  2340.     if (r->float_substr)
  2341.     PerlIO_printf(Perl_debug_log, "floating `%s%s%s'%s at %d..%u ", 
  2342.               PL_colors[0],
  2343.               SvPVX(r->float_substr), 
  2344.               PL_colors[1],
  2345.               SvTAIL(r->float_substr) ? "$" : "",
  2346.               r->float_min_offset, r->float_max_offset);
  2347.     if (r->check_substr)
  2348.     PerlIO_printf(Perl_debug_log, 
  2349.               r->check_substr == r->float_substr 
  2350.               ? "(checking floating" : "(checking anchored");
  2351.     if (r->reganch & ROPT_NOSCAN)
  2352.     PerlIO_printf(Perl_debug_log, " noscan");
  2353.     if (r->reganch & ROPT_CHECK_ALL)
  2354.     PerlIO_printf(Perl_debug_log, " isall");
  2355.     if (r->check_substr)
  2356.     PerlIO_printf(Perl_debug_log, ") ");
  2357.  
  2358.     if (r->regstclass) {
  2359.     regprop(sv, r->regstclass);
  2360.     PerlIO_printf(Perl_debug_log, "stclass `%s' ", SvPVX(sv));
  2361.     }
  2362.     if (r->reganch & ROPT_ANCH) {
  2363.     PerlIO_printf(Perl_debug_log, "anchored");
  2364.     if (r->reganch & ROPT_ANCH_BOL)
  2365.         PerlIO_printf(Perl_debug_log, "(BOL)");
  2366.     if (r->reganch & ROPT_ANCH_MBOL)
  2367.         PerlIO_printf(Perl_debug_log, "(MBOL)");
  2368.     if (r->reganch & ROPT_ANCH_GPOS)
  2369.         PerlIO_printf(Perl_debug_log, "(GPOS)");
  2370.     PerlIO_putc(Perl_debug_log, ' ');
  2371.     }
  2372.     if (r->reganch & ROPT_GPOS_SEEN)
  2373.     PerlIO_printf(Perl_debug_log, "GPOS ");
  2374.     if (r->reganch & ROPT_SKIP)
  2375.     PerlIO_printf(Perl_debug_log, "plus ");
  2376.     if (r->reganch & ROPT_IMPLICIT)
  2377.     PerlIO_printf(Perl_debug_log, "implicit ");
  2378.     PerlIO_printf(Perl_debug_log, "minlen %ld ", (long) r->minlen);
  2379.     if (r->reganch & ROPT_EVAL_SEEN)
  2380.     PerlIO_printf(Perl_debug_log, "with eval ");
  2381.     PerlIO_printf(Perl_debug_log, "\n");
  2382. #endif    /* DEBUGGING */
  2383. }
  2384.  
  2385. /*
  2386. - regprop - printable representation of opcode
  2387. */
  2388. void
  2389. regprop(SV *sv, regnode *o)
  2390. {
  2391. #ifdef DEBUGGING
  2392.     dTHR;
  2393.     register char *p = 0;
  2394.  
  2395.     sv_setpvn(sv, "", 0);
  2396.     switch (OP(o)) {
  2397.     case BOL:
  2398.     p = "BOL";
  2399.     break;
  2400.     case MBOL:
  2401.     p = "MBOL";
  2402.     break;
  2403.     case SBOL:
  2404.     p = "SBOL";
  2405.     break;
  2406.     case EOL:
  2407.     p = "EOL";
  2408.     break;
  2409.     case EOS:
  2410.     p = "EOS";
  2411.     break;
  2412.     case MEOL:
  2413.     p = "MEOL";
  2414.     break;
  2415.     case SEOL:
  2416.     p = "SEOL";
  2417.     break;
  2418.     case ANY:
  2419.     p = "ANY";
  2420.     break;
  2421.     case SANY:
  2422.     p = "SANY";
  2423.     break;
  2424.     case ANYOF:
  2425.     p = "ANYOF";
  2426.     break;
  2427.     case BRANCH:
  2428.     p = "BRANCH";
  2429.     break;
  2430.     case EXACT:
  2431.     sv_catpvf(sv, "EXACT <%s%s%s>", PL_colors[0], OPERAND(o) + 1, PL_colors[1]);
  2432.     break;
  2433.     case EXACTF:
  2434.     sv_catpvf(sv, "EXACTF <%s%s%s>", PL_colors[0], OPERAND(o) + 1, PL_colors[1]);
  2435.     break;
  2436.     case EXACTFL:
  2437.     sv_catpvf(sv, "EXACTFL <%s%s%s>", PL_colors[0], OPERAND(o) + 1, PL_colors[1]);
  2438.     break;
  2439.     case NOTHING:
  2440.     p = "NOTHING";
  2441.     break;
  2442.     case TAIL:
  2443.     p = "TAIL";
  2444.     break;
  2445.     case BACK:
  2446.     p = "BACK";
  2447.     break;
  2448.     case END:
  2449.     p = "END";
  2450.     break;
  2451.     case BOUND:
  2452.     p = "BOUND";
  2453.     break;
  2454.     case BOUNDL:
  2455.     p = "BOUNDL";
  2456.     break;
  2457.     case NBOUND:
  2458.     p = "NBOUND";
  2459.     break;
  2460.     case NBOUNDL:
  2461.     p = "NBOUNDL";
  2462.     break;
  2463.     case CURLY:
  2464.     sv_catpvf(sv, "CURLY {%d,%d}", ARG1(o), ARG2(o));
  2465.     break;
  2466.     case CURLYM:
  2467.     sv_catpvf(sv, "CURLYM[%d] {%d,%d}", o->flags, ARG1(o), ARG2(o));
  2468.     break;
  2469.     case CURLYN:
  2470.     sv_catpvf(sv, "CURLYN[%d] {%d,%d}", o->flags, ARG1(o), ARG2(o));
  2471.     break;
  2472.     case CURLYX:
  2473.     sv_catpvf(sv, "CURLYX {%d,%d}", ARG1(o), ARG2(o));
  2474.     break;
  2475.     case REF:
  2476.     sv_catpvf(sv, "REF%d", ARG(o));
  2477.     break;
  2478.     case REFF:
  2479.     sv_catpvf(sv, "REFF%d", ARG(o));
  2480.     break;
  2481.     case REFFL:
  2482.     sv_catpvf(sv, "REFFL%d", ARG(o));
  2483.     break;
  2484.     case OPEN:
  2485.     sv_catpvf(sv, "OPEN%d", ARG(o));
  2486.     break;
  2487.     case CLOSE:
  2488.     sv_catpvf(sv, "CLOSE%d", ARG(o));
  2489.     p = NULL;
  2490.     break;
  2491.     case STAR:
  2492.     p = "STAR";
  2493.     break;
  2494.     case PLUS:
  2495.     p = "PLUS";
  2496.     break;
  2497.     case MINMOD:
  2498.     p = "MINMOD";
  2499.     break;
  2500.     case GPOS:
  2501.     p = "GPOS";
  2502.     break;
  2503.     case UNLESSM:
  2504.     sv_catpvf(sv, "UNLESSM[-%d]", o->flags);
  2505.     break;
  2506.     case IFMATCH:
  2507.     sv_catpvf(sv, "IFMATCH[-%d]", o->flags);
  2508.     break;
  2509.     case SUCCEED:
  2510.     p = "SUCCEED";
  2511.     break;
  2512.     case WHILEM:
  2513.     p = "WHILEM";
  2514.     break;
  2515.     case DIGIT:
  2516.     p = "DIGIT";
  2517.     break;
  2518.     case NDIGIT:
  2519.     p = "NDIGIT";
  2520.     break;
  2521.     case ALNUM:
  2522.     p = "ALNUM";
  2523.     break;
  2524.     case NALNUM:
  2525.     p = "NALNUM";
  2526.     break;
  2527.     case SPACE:
  2528.     p = "SPACE";
  2529.     break;
  2530.     case NSPACE:
  2531.     p = "NSPACE";
  2532.     break;
  2533.     case ALNUML:
  2534.     p = "ALNUML";
  2535.     break;
  2536.     case NALNUML:
  2537.     p = "NALNUML";
  2538.     break;
  2539.     case SPACEL:
  2540.     p = "SPACEL";
  2541.     break;
  2542.     case NSPACEL:
  2543.     p = "NSPACEL";
  2544.     break;
  2545.     case EVAL:
  2546.     p = "EVAL";
  2547.     break;
  2548.     case LONGJMP:
  2549.     p = "LONGJMP";
  2550.     break;
  2551.     case BRANCHJ:
  2552.     p = "BRANCHJ";
  2553.     break;
  2554.     case IFTHEN:
  2555.     p = "IFTHEN";
  2556.     break;
  2557.     case GROUPP:
  2558.     sv_catpvf(sv, "GROUPP%d", ARG(o));
  2559.     break;
  2560.     case LOGICAL:
  2561.     p = "LOGICAL";
  2562.     break;
  2563.     case SUSPEND:
  2564.     p = "SUSPEND";
  2565.     break;
  2566.     case RENUM:
  2567.     p = "RENUM";
  2568.     break;
  2569.     case OPTIMIZED:
  2570.     p = "OPTIMIZED";
  2571.     break;
  2572.     default:
  2573.     FAIL("corrupted regexp opcode");
  2574.     }
  2575.     if (p)
  2576.     sv_catpv(sv, p);
  2577. #endif    /* DEBUGGING */
  2578. }
  2579.  
  2580. void
  2581. pregfree(struct regexp *r)
  2582. {
  2583.     dTHR;
  2584.     if (!r || (--r->refcnt > 0))
  2585.     return;
  2586.     if (r->precomp)
  2587.     Safefree(r->precomp);
  2588.     if (r->subbase)
  2589.     Safefree(r->subbase);
  2590.     if (r->substrs) {
  2591.     if (r->anchored_substr)
  2592.         SvREFCNT_dec(r->anchored_substr);
  2593.     if (r->float_substr)
  2594.         SvREFCNT_dec(r->float_substr);
  2595.     Safefree(r->substrs);
  2596.     }
  2597.     if (r->data) {
  2598.     int n = r->data->count;
  2599.     while (--n >= 0) {
  2600.         switch (r->data->what[n]) {
  2601.         case 's':
  2602.         SvREFCNT_dec((SV*)r->data->data[n]);
  2603.         break;
  2604.         case 'o':
  2605.         op_free((OP_4tree*)r->data->data[n]);
  2606.         break;
  2607.         case 'n':
  2608.         break;
  2609.         default:
  2610.         FAIL2("panic: regfree data code '%c'", r->data->what[n]);
  2611.         }
  2612.     }
  2613.     Safefree(r->data->what);
  2614.     Safefree(r->data);
  2615.     }
  2616.     Safefree(r->startp);
  2617.     Safefree(r->endp);
  2618.     Safefree(r);
  2619. }
  2620.  
  2621. /*
  2622.  - regnext - dig the "next" pointer out of a node
  2623.  *
  2624.  * [Note, when REGALIGN is defined there are two places in regmatch()
  2625.  * that bypass this code for speed.]
  2626.  */
  2627. regnode *
  2628. regnext(register regnode *p)
  2629. {
  2630.     dTHR;
  2631.     register I32 offset;
  2632.  
  2633.     if (p == &PL_regdummy)
  2634.     return(NULL);
  2635.  
  2636.     offset = (reg_off_by_arg[OP(p)] ? ARG(p) : NEXT_OFF(p));
  2637.     if (offset == 0)
  2638.     return(NULL);
  2639.  
  2640.     return(p+offset);
  2641. }
  2642.  
  2643. STATIC void    
  2644. re_croak2(const char* pat1,const char* pat2,...)
  2645. {
  2646.     va_list args;
  2647.     STRLEN l1 = strlen(pat1);
  2648.     STRLEN l2 = strlen(pat2);
  2649.     char buf[512];
  2650.     char *message;
  2651.  
  2652.     if (l1 > 510)
  2653.     l1 = 510;
  2654.     if (l1 + l2 > 510)
  2655.     l2 = 510 - l1;
  2656.     Copy(pat1, buf, l1 , char);
  2657.     Copy(pat2, buf + l1, l2 , char);
  2658.     buf[l1 + l2] = '\n';
  2659.     buf[l1 + l2 + 1] = '\0';
  2660.     va_start(args, pat2);
  2661.     message = mess(buf, &args);
  2662.     va_end(args);
  2663.     l1 = strlen(message);
  2664.     if (l1 > 512)
  2665.     l1 = 512;
  2666.     Copy(message, buf, l1 , char);
  2667.     buf[l1] = '\0';            /* Overwrite \n */
  2668.     croak("%s", buf);
  2669. }
  2670.